[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 20 Feb 2015 09:43:40 +0000 (10:43 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 20 Feb 2015 09:43:40 +0000 (10:43 +0100)
2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>

* s-stalib.ads: Fix typo.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

* exp_ch3.adb (Default_Initialize_Object): If the object has a
delayed freeze, the actions associated with default initialization
must be part of the freeze actions, rather that being inserted
directly after the object declaration.

2015-02-20  Robert Dewar  <dewar@adacore.com>

* lib-load.adb: Minor comment update.

2015-02-20  Vincent Celier  <celier@adacore.com>

* prj-proc.adb (Process_Case_Construction): When there are
incomplete withed projects and the case variable is unknown,
skip the case construction.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

* exp_ch6.adb (Expand_Actuals): Add caller-side invariant checks
when an actual is a view conversion, either because the call is
to an inherited operation, or because the actual is an explicit
type conversion to an ancestor type.  Fixes ACATS 4.0D: C732001

From-SVN: r220840

gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch6.adb
gcc/ada/lib-load.adb
gcc/ada/prj-proc.adb
gcc/ada/s-stalib.ads

index bad2730d0a2ffc658e4f7bc7abb1d34ae1133d05..2144ec83d51584d492ba6e4ff64298ac1dcbcd12 100644 (file)
@@ -1,3 +1,31 @@
+2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * s-stalib.ads: Fix typo.
+
+2015-02-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch3.adb (Default_Initialize_Object): If the object has a
+       delayed freeze, the actions associated with default initialization
+       must be part of the freeze actions, rather that being inserted
+       directly after the object declaration.
+
+2015-02-20  Robert Dewar  <dewar@adacore.com>
+
+       * lib-load.adb: Minor comment update.
+
+2015-02-20  Vincent Celier  <celier@adacore.com>
+
+       * prj-proc.adb (Process_Case_Construction): When there are
+       incomplete withed projects and the case variable is unknown,
+       skip the case construction.
+
+2015-02-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch6.adb (Expand_Actuals): Add caller-side invariant checks
+       when an actual is a view conversion, either because the call is
+       to an inherited operation, or because the actual is an explicit
+       type conversion to an ancestor type.  Fixes ACATS 4.0D: C732001
+
 2015-02-20  Robert Dewar  <dewar@adacore.com>
 
        * einfo.ads: Minor comment updates Fix missing pragma Inline
index 095e23368b38583f640e2a15e425e337e5c8214b..3d0ee1f76600ca821aecca21189c6a76453e5731 100644 (file)
@@ -5356,8 +5356,15 @@ package body Exp_Ch3 is
          end if;
 
          --  Step 4: Insert the whole initialization sequence into the tree
+         --  If the object has a delayed freeze, as will be the case when
+         --  it has aspect specifications, the initialization sequence is
+         --  part of the freeze actions.
 
-         Insert_Actions_After (After, Abrt_Stmts);
+         if Has_Delayed_Freeze (Def_Id) then
+            Append_Freeze_Actions (Def_Id, Abrt_Stmts);
+         else
+            Insert_Actions_After (After, Abrt_Stmts);
+         end if;
       end Default_Initialize_Object;
 
       -------------------------
index 577637042281b82596e96782002a57e404040a5f..c9c5da2cbe943ef29002d36c6b17042cd1450b0c 100644 (file)
@@ -970,6 +970,10 @@ package body Exp_Ch6 is
    -- Expand_Actuals --
    --------------------
 
+   --------------------
+   -- Expand_Actuals --
+   --------------------
+
    procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id) is
       Loc       : constant Source_Ptr := Sloc (N);
       Actual    : Node_Id;
@@ -1750,10 +1754,50 @@ package body Exp_Ch6 is
             --  be handled separately because the name does not denote an
             --  overloadable entity.
 
-            declare
+            By_Ref_Predicate_Check : declare
                Aund : constant Entity_Id := Underlying_Type (E_Actual);
                Atyp : Entity_Id;
 
+               function Is_Public_Subp return Boolean;
+               --  Check whether the subprogram being called is a visible
+               --  operation of the type of the actual. Used to determine
+               --  whether an invariant check must be generated on the
+               --  caller side.
+
+               ---------------------
+               --  Is_Public_Subp --
+               ---------------------
+
+               function Is_Public_Subp return Boolean is
+                  Pack      : constant Entity_Id := Scope (Subp);
+                  Subp_Decl : Node_Id;
+
+               begin
+                  if not Is_Subprogram (Subp) then
+                     return False;
+
+                  --  The operation may be inherited, or a primitive of the
+                  --  root type.
+
+                  elsif
+                    Nkind_In (Parent (Subp), N_Private_Extension_Declaration,
+                                             N_Full_Type_Declaration)
+                  then
+                     Subp_Decl := Parent (Subp);
+
+                  else
+                     Subp_Decl := Unit_Declaration_Node (Subp);
+                  end if;
+
+                  return Ekind (Pack) = E_Package
+                    and then
+                      List_Containing (Subp_Decl) =
+                        Visible_Declarations
+                          (Specification (Unit_Declaration_Node (Pack)));
+               end Is_Public_Subp;
+
+            --  Start of processing for By_Ref_Predicate_Check
+
             begin
                if No (Aund) then
                   Atyp := E_Actual;
@@ -1771,7 +1815,34 @@ package body Exp_Ch6 is
                   Append_To (Post_Call,
                     Make_Predicate_Check (Atyp, Actual));
                end if;
-            end;
+
+               --  We generated caller-side invariant checks in two cases:
+
+               --  a) when calling an inherited operation, where there is an
+               --  implicit view conversion of the actual to the parent type.
+
+               --  b) When the conversion is explicit
+
+               --  We treat these cases separately because the required
+               --  conversion for a) is added later when expanding the call.
+
+               if Has_Invariants (Etype (Actual))
+                  and then
+                    Nkind (Parent (Subp)) = N_Private_Extension_Declaration
+               then
+                  if  Comes_From_Source (N) and then Is_Public_Subp then
+                     Append_To (Post_Call, Make_Invariant_Call (Actual));
+                  end if;
+
+               elsif Nkind (Actual) = N_Type_Conversion
+                 and then Has_Invariants (Etype (Expression (Actual)))
+               then
+                  if Comes_From_Source (N) and then Is_Public_Subp then
+                     Append_To (Post_Call,
+                       Make_Invariant_Call (Expression (Actual)));
+                  end if;
+               end if;
+            end By_Ref_Predicate_Check;
 
          --  Processing for IN parameters
 
@@ -7609,6 +7680,7 @@ package body Exp_Ch6 is
 
                   if Present (Class_Pre) then
                      Merge_Preconditions (Check_Prag, Class_Pre);
+
                   else
                      Class_Pre := Check_Prag;
                   end if;
index aef313f979b6627b7360f80c287dde617ac0fb54..83d3576eeb6f1e56813491b5f073abc99d1ce6f6 100644 (file)
@@ -740,7 +740,7 @@ package body Lib.Load is
                goto Done;
             end if;
 
-            --  If loaded unit had a fatal error, then caller inherits setting
+            --  If loaded unit had an error, then caller inherits setting
 
             if Present (Error_Node) then
                case Units.Table (Unum).Fatal_Error is
index 3bad060b180b70025610fe387489563b68ab9214..57b88c651bf6fe326ad3e9c681d62c932af5166d 100644 (file)
@@ -2363,13 +2363,17 @@ package body Prj.Proc is
             end if;
 
             if Var_Id = No_Variable then
+               if Node_Tree.Incomplete_With then
+                  return;
 
                --  Should never happen, because this has already been checked
                --  during parsing.
 
-               Write_Line
-                 ("variable """ & Get_Name_String (Name) & """ not found");
-               raise Program_Error;
+               else
+                  Write_Line
+                    ("variable """ & Get_Name_String (Name) & """ not found");
+                  raise Program_Error;
+               end if;
             end if;
 
             --  Get the case variable
index e3e8e10adc677ffd1e0e8129497271ac89cb2428..8d96677dad04fa8fd6145e35cb75270cd9ae9b63 100644 (file)
@@ -242,7 +242,7 @@ package System.Standard_Library is
    --  A little procedure that just calls Abort_Undefer.all, for use in
    --  clean up procedures, which only permit a simple subprogram name.
    --  ??? This procedure is not marked inline because the front-end
-   --  cannot currently mark its calls from at-end handers as inlined.
+   --  cannot currently mark its calls from at-end handlers as inlined.
 
    procedure Adafinal;
    --  Performs the Ada Runtime finalization the first time it is invoked.