[multiple changes]

2014-10-23  Robert Dewar  <dewar@adacore.com>

	* sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In).
	* sem_ch3.adb: Minor reformatting.

2014-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Associations): If an actual for a formal
	object is a call to a parameterless expression function, add
	the function to the list of actuals to freeze.
	* freeze.adb (Check_Expression_Function): Create freeze nodes of
	outer types that may be references in the body of the expression.

From-SVN: r216583

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 32777f6617e29bd0ff069b2b5d9cf670cf830f00..216f814c98b7264e70522d57a1256cb93ebe347c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2014-10-23  Robert Dewar  <dewar@adacore.com>
+
+       * sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In).
+       * sem_ch3.adb: Minor reformatting.
+
+2014-10-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch12.adb (Analyze_Associations): If an actual for a formal
+       object is a call to a parameterless expression function, add
+       the function to the list of actuals to freeze.
+       * freeze.adb (Check_Expression_Function): Create freeze nodes of
+       outer types that may be references in the body of the expression.
+
 2014-10-23  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_util.ads, checks.ads: Minor comment reformatting.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5b4bfd9b5d7e8185df2b997a7d9c469e9f07f6ab..156afda2e655ed4eee4b5eb344767c72e875d77f 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -112,6 +112,11 @@ package body Freeze is
    --  to deferred constants without completion. We report this at the freeze
    --  point of the function, to provide a better error message.
 
+   --  In most cases the expression itself is frozen by the time the function
+   --  itself is frozen, because the formals will be frozen by then. However,
+   --  Attribute references to outer types are freeze points for those types;
+   --  this routine generates the required freeze nodes for them.
+
    procedure Check_Strict_Alignment (E : Entity_Id);
    --  E is a base type. If E is tagged or has a component that is aliased
    --  or tagged or contains something this is aliased or tagged, set
@@ -1272,6 +1277,14 @@ package body Freeze is
          then
             Error_Msg_NE
               ("premature use of& in call or instance", N, Entity (Nod));
+
+         elsif Nkind (Nod) = N_Attribute_Reference then
+            Analyze (Prefix (Nod));
+            if Is_Entity_Name (Prefix (Nod))
+              and then Is_Type (Entity (Prefix (Nod)))
+            then
+               Freeze_Before (N, Entity (Prefix (Nod)));
+            end if;
          end if;
 
          return OK;
@@ -5983,7 +5996,7 @@ package body Freeze is
       --  and the expressions include allocators, the designed type is frozen
       --  as well.
 
-      function In_Exp_Body (N : Node_Id) return Boolean;
+      function In_Expanded_Body (N : Node_Id) return Boolean;
       --  Given an N_Handled_Sequence_Of_Statements node N, determines whether
       --  it is the handled statement sequence of an expander-generated
       --  subprogram (init proc, stream subprogram, or renaming as body).
@@ -6023,11 +6036,11 @@ package body Freeze is
          return Empty;
       end Find_Aggregate_Component_Desig_Type;
 
-      -----------------
-      -- In_Exp_Body --
-      -----------------
+      ----------------------
+      -- In_Expanded_Body --
+      ----------------------
 
-      function In_Exp_Body (N : Node_Id) return Boolean is
+      function In_Expanded_Body (N : Node_Id) return Boolean is
          P  : Node_Id;
          Id : Entity_Id;
 
@@ -6044,7 +6057,8 @@ package body Freeze is
          else
             Id := Defining_Unit_Name (Specification (P));
 
-            --  Following complex conditional could use comments ???
+            --  The following are expander-created bodies, or bodies that
+            --  are not freeze points.
 
             if Nkind (Id) = N_Defining_Identifier
               and then (Is_Init_Proc (Id)
@@ -6061,7 +6075,7 @@ package body Freeze is
                return False;
             end if;
          end if;
-      end In_Exp_Body;
+      end In_Expanded_Body;
 
    --  Start of processing for Freeze_Expression
 
@@ -6314,7 +6328,7 @@ package body Freeze is
                --  outside this body, not inside it, and we skip past the
                --  subprogram body that we are inside.
 
-               if In_Exp_Body (Parent_P) then
+               if In_Expanded_Body (Parent_P) then
                   declare
                      Subp : constant Node_Id := Parent (Parent_P);
                      Spec : Entity_Id;
@@ -6358,7 +6372,7 @@ package body Freeze is
                      --  of F (2) would place Hidden's freeze node (1) in the
                      --  wrong place. Avoid explicit freezing and let the usual
                      --  scenarios do the job - for example, reaching the end
-                     --  of the private declarations.
+                     --  of the private declarations, or a call to F.
 
                      if Nkind (Original_Node (Subp)) =
                                                 N_Expression_Function

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3b84679534a329bdcb3c6a5db6f82478f8b46c29..71a73272b26f49cebe5e5786acbcb5848ea25669 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1664,6 +1664,18 @@ package body Sem_Ch12 is
                         Assoc);
                   end if;
 
+                  --  If the object is a call to an expression function, this
+                  --  is a freezing point for it.
+
+                  if Is_Entity_Name (Match)
+                    and then Present (Entity (Match))
+                    and then Nkind
+                      (Original_Node (Unit_Declaration_Node (Entity (Match))))
+                        = N_Expression_Function
+                  then
+                     Append_Elmt (Entity (Match), Actuals_To_Freeze);
+                  end if;
+
                when N_Formal_Type_Declaration =>
                   Match :=
                     Matching_Actual (

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index aab006c478e5eb1530041b9465788dad9d5bc687..bafeb62bbdb483b2bbcb74121713c5ebc51806ed 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6942,6 +6942,7 @@ package body Sem_Ch3 is
          return;
 
       elsif Has_Discriminants (Parent_Type) then
+
          --  Build partial view of derived type from partial view of parent.
          --  This must be done before building the full derivation because the
          --  second derivation will modify the discriminants of the first and

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 4f83aaed4038bafd66c86e9bf70c3a7d25293e60..9b9034a74b01968c1c2868c78d7d09f934cb9c0c 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -765,9 +765,9 @@ package body Sem_Type is
            Is_Private_Type (Typ1)
              and then
               ((Present (Full_View (Typ1))
-                  and then Covers (Full_View (Typ1), Typ2))
+                 and then Covers (Full_View (Typ1), Typ2))
                 or else (Present (Underlying_Full_View (Typ1))
-                           and then Covers (Underlying_Full_View (Typ1), Typ2))
+                          and then Covers (Underlying_Full_View (Typ1), Typ2))
                 or else Base_Type (Typ1) = Typ2
                 or else Base_Type (Typ2) = Typ1);
       end Full_View_Covers;
@@ -989,11 +989,11 @@ package body Sem_Type is
       --  attributes require some real type, etc. The built-in types Any_XXX
       --  represent these classes.
 
-      elsif (T1 = Any_Integer and then Is_Integer_Type (T2))
-        or else (T1 = Any_Boolean and then Is_Boolean_Type (T2))
-        or else (T1 = Any_Real and then Is_Real_Type (T2))
-        or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2))
-        or else (T1 = Any_Discrete and then Is_Discrete_Type (T2))
+      elsif     (T1 = Any_Integer  and then Is_Integer_Type     (T2))
+        or else (T1 = Any_Boolean  and then Is_Boolean_Type     (T2))
+        or else (T1 = Any_Real     and then Is_Real_Type        (T2))
+        or else (T1 = Any_Fixed    and then Is_Fixed_Point_Type (T2))
+        or else (T1 = Any_Discrete and then Is_Discrete_Type    (T2))
       then
          return True;
 
@@ -1022,16 +1022,16 @@ package body Sem_Type is
         and then Ekind (BT1) = E_General_Access_Type
         and then Ekind (BT2) = E_Anonymous_Access_Type
         and then (Covers (Designated_Type (T1), Designated_Type (T2))
-                   or else Covers (Designated_Type (T2), Designated_Type (T1)))
+                    or else
+                  Covers (Designated_Type (T2), Designated_Type (T1)))
       then
          return True;
 
       --  An Access_To_Subprogram is compatible with itself, or with an
       --  anonymous type created for an attribute reference Access.
 
-      elsif (Ekind (BT1) = E_Access_Subprogram_Type
-               or else
-             Ekind (BT1) = E_Access_Protected_Subprogram_Type)
+      elsif Ekind_In (BT1, E_Access_Subprogram_Type,
+                           E_Access_Protected_Subprogram_Type)
         and then Is_Access_Type (T2)
         and then (not Comes_From_Source (T1)
                    or else not Comes_From_Source (T2))
@@ -1046,10 +1046,8 @@ package body Sem_Type is
       --  with itself, or with an anonymous type created for an attribute
       --  reference Access.
 
-      elsif (Ekind (BT1) = E_Anonymous_Access_Subprogram_Type
-               or else
-             Ekind (BT1)
-                      = E_Anonymous_Access_Protected_Subprogram_Type)
+      elsif Ekind_In (BT1, E_Anonymous_Access_Subprogram_Type,
+                           E_Anonymous_Access_Protected_Subprogram_Type)
         and then Is_Access_Type (T2)
         and then (not Comes_From_Source (T1)
                    or else not Comes_From_Source (T2))
@@ -1258,7 +1256,7 @@ package body Sem_Type is
         and then Ekind (T2) = E_Anonymous_Access_Type
         and then Is_Generic_Type (Directly_Designated_Type (T1))
         and then Get_Instance_Of (Directly_Designated_Type (T1)) =
-                   Directly_Designated_Type (T2)
+                                               Directly_Designated_Type (T2)
       then
          return True;
 
@@ -1387,9 +1385,8 @@ package body Sem_Type is
       function Is_Actual_Subprogram (S : Entity_Id) return Boolean is
       begin
          return In_Open_Scopes (Scope (S))
-           and then
-             Nkind (Unit_Declaration_Node (S)) =
-               N_Subprogram_Renaming_Declaration
+           and then Nkind (Unit_Declaration_Node (S)) =
+                                         N_Subprogram_Renaming_Declaration
 
            --  Why the Comes_From_Source test here???
 
@@ -1542,8 +1539,8 @@ package body Sem_Type is
 
                if Nkind (Act1) in N_Op
                  and then Is_Overloaded (Act1)
-                 and then (Nkind (Right_Opnd (Act1)) = N_Integer_Literal
-                            or else Nkind (Right_Opnd (Act1)) = N_Real_Literal)
+                 and then Nkind_In (Right_Opnd (Act1), N_Integer_Literal,
+                                                       N_Real_Literal)
                  and then Has_Compatible_Type (Act1, Standard_Boolean)
                  and then Etype (F1) = Standard_Boolean
                then
@@ -1725,8 +1722,7 @@ package body Sem_Type is
       if Convention (Nam1) = Convention_CIL
         and then Convention (Nam2) = Convention_CIL
         and then Ekind (Nam1) = Ekind (Nam2)
-        and then (Ekind (Nam1) = E_Procedure
-                   or else Ekind (Nam1) = E_Function)
+        and then Ekind_In (Nam1, E_Procedure, E_Function)
       then
          return It2;
       end if;
@@ -1737,9 +1733,7 @@ package body Sem_Type is
       --  then we must check whether the user-defined entity hides the prede-
       --  fined one.
 
-      if Chars (Nam1) in Any_Operator_Name
-        and then Standard_Operator
-      then
+      if Chars (Nam1) in Any_Operator_Name and then Standard_Operator then
          if        Typ = Universal_Integer
            or else Typ = Universal_Real
            or else Typ = Any_Integer
@@ -2072,7 +2066,7 @@ package body Sem_Type is
               and then
                 In_Same_Declaration_List
                   (Designated_Type (Operand_Type),
-                     Unit_Declaration_Node (User_Subp))
+                   Unit_Declaration_Node (User_Subp))
             then
                if It2.Nam = Predef_Subp then
                   return It1;
@@ -2383,9 +2377,9 @@ package body Sem_Type is
          Get_First_Interp (N, I, It);
          while Present (It.Typ) loop
             if (Covers (Typ, It.Typ)
-                  and then
-                    (Scope (It.Nam) /= Standard_Standard
-                       or else not Is_Invisible_Operator (N, Base_Type (Typ))))
+                 and then
+                   (Scope (It.Nam) /= Standard_Standard
+                     or else not Is_Invisible_Operator (N, Base_Type (Typ))))
 
                --  Ada 2005 (AI-345)