[multiple changes]

2016-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual
	subtypes for unconstrained formals when analyzing the generated
	body of an expression function, because it may lead to premature
	and misplaced freezing of the types of formals.

2016-06-14  Gary Dismukes  <dismukes@adacore.com>

	* sem_elab.adb, sem_ch4.adb: Minor reformatting and typo fix.

2016-06-14  Tristan Gingold  <gingold@adacore.com>

	* einfo.adb (Set_Has_Timing_Event): Add assertion.
	* sem_util.ads, sem_util.adb (Propagate_Concurrent_Flags): New
	name for Propagate_Type_Has_Flags.
	* exp_ch3.adb, sem_ch3.adb, sem_ch7.adb, sem_ch9.adb: Adjust after
	renaming.

From-SVN: r237439

11 files changed, 56 insertions, 26 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ef70ce5..ebdf963 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2016-06-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual
+	subtypes for unconstrained formals when analyzing the generated
+	body of an expression function, because it may lead to premature
+	and misplaced freezing of the types of formals.
+
+2016-06-14  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_elab.adb, sem_ch4.adb: Minor reformatting and typo fix.
+
+2016-06-14  Tristan Gingold  <gingold@adacore.com>
+
+	* einfo.adb (Set_Has_Timing_Event): Add assertion.
+	* sem_util.ads, sem_util.adb (Propagate_Concurrent_Flags): New
+	name for Propagate_Type_Has_Flags.
+	* exp_ch3.adb, sem_ch3.adb, sem_ch7.adb, sem_ch9.adb: Adjust after
+	renaming.
+
 2016-06-14  Bob Duff  <duff@adacore.com>
 
 	* sem_elab.adb (Check_A_Call): Do nothing if the callee is
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 8f4a134..f812026 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -4885,6 +4885,7 @@ package body Einfo is
 
    procedure Set_Has_Timing_Event (Id : E; V : B := True) is
    begin
+      pragma Assert (Id = Base_Type (Id));
       Set_Flag289 (Id, V);
    end Set_Has_Timing_Event;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7f98b91..0625273 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4619,7 +4619,7 @@ package body Exp_Ch3 is
          --  been a private type at the point of definition. Same if component
          --  type is controlled or contains protected objects.
 
-         Propagate_Type_Has_Flags (Base, Comp_Typ);
+         Propagate_Concurrent_Flags (Base, Comp_Typ);
          Set_Has_Controlled_Component
            (Base, Has_Controlled_Component (Comp_Typ)
                     or else Is_Controlled (Comp_Typ));
@@ -5189,7 +5189,7 @@ package body Exp_Ch3 is
       while Present (Comp) loop
          Comp_Typ := Etype (Comp);
 
-         Propagate_Type_Has_Flags (Typ, Comp_Typ);
+         Propagate_Concurrent_Flags (Typ, Comp_Typ);
 
          --  Do not set Has_Controlled_Component on a class-wide equivalent
          --  type. See Make_CW_Equivalent_Type.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9f13bd9..4e5b8f7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4514,7 +4514,7 @@ package body Sem_Ch3 is
       Set_Default_SSO      (T);
 
       Set_Etype            (T,                Parent_Base);
-      Propagate_Type_Has_Flags (T, Parent_Base);
+      Propagate_Concurrent_Flags (T, Parent_Base);
 
       Set_Convention       (T, Convention     (Parent_Type));
       Set_First_Rep_Item   (T, First_Rep_Item (Parent_Type));
@@ -5573,7 +5573,7 @@ package body Sem_Ch3 is
 
          Set_First_Index       (Implicit_Base, First_Index (T));
          Set_Component_Type    (Implicit_Base, Element_Type);
-         Propagate_Type_Has_Flags (Implicit_Base, Element_Type);
+         Propagate_Concurrent_Flags (Implicit_Base, Element_Type);
          Set_Component_Size    (Implicit_Base, Uint_0);
          Set_Packed_Array_Impl_Type (Implicit_Base, Empty);
          Set_Has_Controlled_Component (Implicit_Base,
@@ -5599,7 +5599,7 @@ package body Sem_Ch3 is
          Set_Is_Constrained           (T, False);
          Set_First_Index              (T, First (Subtype_Marks (Def)));
          Set_Has_Delayed_Freeze       (T, True);
-         Propagate_Type_Has_Flags     (T, Element_Type);
+         Propagate_Concurrent_Flags   (T, Element_Type);
          Set_Has_Controlled_Component (T, Has_Controlled_Component
                                                         (Element_Type)
                                             or else
@@ -8948,9 +8948,9 @@ package body Sem_Ch3 is
 
       Set_Scope                (Derived_Type, Current_Scope);
 
-      Set_Etype                (Derived_Type,                Parent_Base);
-      Set_Ekind                (Derived_Type, Ekind         (Parent_Base));
-      Propagate_Type_Has_Flags (Derived_Type, Parent_Base);
+      Set_Etype                  (Derived_Type,        Parent_Base);
+      Set_Ekind                  (Derived_Type, Ekind (Parent_Base));
+      Propagate_Concurrent_Flags (Derived_Type,        Parent_Base);
 
       Set_Size_Info          (Derived_Type,                     Parent_Type);
       Set_RM_Size            (Derived_Type, RM_Size            (Parent_Type));
@@ -13707,7 +13707,7 @@ package body Sem_Ch3 is
       Set_Component_Size           (T1, Component_Size           (T2));
       Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
       Set_Has_Non_Standard_Rep     (T1, Has_Non_Standard_Rep     (T2));
-      Propagate_Type_Has_Flags     (T1, T2);
+      Propagate_Concurrent_Flags   (T1, T2);
       Set_Is_Packed                (T1, Is_Packed                (T2));
       Set_Has_Aliased_Components   (T1, Has_Aliased_Components   (T2));
       Set_Has_Atomic_Components    (T1, Has_Atomic_Components    (T2));
@@ -19924,7 +19924,7 @@ package body Sem_Ch3 is
                Set_Class_Wide_Type
                  (Base_Type (Full_T), Class_Wide_Type (Priv_T));
 
-               Propagate_Type_Has_Flags (Class_Wide_Type (Priv_T), Full_T);
+               Propagate_Concurrent_Flags (Class_Wide_Type (Priv_T), Full_T);
             end if;
          end;
       end if;
@@ -21280,7 +21280,7 @@ package body Sem_Ch3 is
             Init_Component_Location (Component);
          end if;
 
-         Propagate_Type_Has_Flags (T, Etype (Component));
+         Propagate_Concurrent_Flags (T, Etype (Component));
 
          if Ekind (Component) /= E_Component then
             null;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index edcfee2..a109cd0 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3917,9 +3917,9 @@ package body Sem_Ch4 is
       if Warn_On_Suspicious_Contract
         and then not Referenced (Loop_Id, Cond)
       then
-         --  Generating C this check causes spurious warnings on inlined
+         --  Generating C, this check causes spurious warnings on inlined
          --  postconditions; we can safely disable it because this check
-         --  was previously performed when analying the internally built
+         --  was previously performed when analyzing the internally built
          --  postconditions procedure.
 
          if Modify_Tree_For_C and then In_Inlined_Body then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a6ac292..4f7efc3 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11150,6 +11150,16 @@ package body Sem_Ch6 is
          return;
       end if;
 
+      --  The subtype declarations may freeze the formals. The body generated
+      --  for an expression function is not a freeze point, so do not emit
+      --  these declarations (small loss of efficiency in rare cases).
+
+      if Nkind (N) = N_Subprogram_Body
+        and then Was_Expression_Function (N)
+      then
+         return;
+      end if;
+
       Formal := First_Formal (Subp);
       while Present (Formal) loop
          T := Etype (Formal);
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 8c318fd..0c235f6 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2585,7 +2585,7 @@ package body Sem_Ch7 is
             Set_Finalize_Storage_Only
                               (Priv, Finalize_Storage_Only
                                                    (Base_Type (Full)));
-            Propagate_Type_Has_Flags
+            Propagate_Concurrent_Flags
                               (Priv,                Base_Type (Full));
             Set_Has_Controlled_Component
                               (Priv, Has_Controlled_Component
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index adfd27d..aa2a18d 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1938,7 +1938,7 @@ package body Sem_Ch9 is
          if Ekind_In (E, E_Function, E_Procedure) then
             Set_Convention (E, Convention_Protected);
          else
-            Propagate_Type_Has_Flags (Current_Scope, Etype (E));
+            Propagate_Concurrent_Flags (Current_Scope, Etype (E));
          end if;
 
          Next_Entity (E);
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 27fed6f..4805440 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -128,7 +128,7 @@ package body Sem_Elab is
      Table_Name           => "Delay_Check");
 
    C_Scope : Entity_Id;
-   --  Top level scope of current scope. Compute this only once at the outer
+   --  Top-level scope of current scope. Compute this only once at the outer
    --  level, i.e. for a call to Check_Elab_Call from outside this unit.
 
    Outer_Level_Sloc : Source_Ptr;
@@ -532,7 +532,7 @@ package body Sem_Elab is
        --  Msg_S is an info message (output if Elab_Info_Messages is set.
 
       function Find_W_Scope return Entity_Id;
-      --  Find top level scope for called entity (not following renamings
+      --  Find top-level scope for called entity (not following renamings
       --  or derivations). This is where the Elaborate_All will go if it is
       --  needed. We start with the called entity, except in the case of an
       --  initialization procedure outside the current package, where the init
@@ -653,7 +653,7 @@ package body Sem_Elab is
       --  we ignore this flag.
 
       E_Scope : Entity_Id;
-      --  Top level scope of entity for called subprogram. This value includes
+      --  Top-level scope of entity for called subprogram. This value includes
       --  following renamings and derivations, so this scope can be in a
       --  non-visible unit. This is the scope that is to be investigated to
       --  see whether an elaboration check is required.
@@ -667,7 +667,7 @@ package body Sem_Elab is
       --  Flag set when a source entity is called during elaboration in SPARK
 
       W_Scope : constant Entity_Id := Find_W_Scope;
-      --  Top level scope of directly called entity for subprogram. This
+      --  Top-level scope of directly called entity for subprogram. This
       --  differs from E_Scope in the case where renamings or derivations
       --  are involved, since it does not follow these links. W_Scope is
       --  generally in a visible unit, and it is this scope that may require
@@ -1587,7 +1587,7 @@ package body Sem_Elab is
 
                      --  Static model, call is not in elaboration code, we
                      --  never need to worry, because in the static model the
-                     --  top level caller always takes care of things.
+                     --  top-level caller always takes care of things.
 
                      else
                         return;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 020e6d7..c39e3a6 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18359,11 +18359,11 @@ package body Sem_Util is
       Set_Sloc (Endl, Loc);
    end Process_End_Label;
 
-   ------------------------------
-   -- Propagate_Type_Has_Flags --
-   ------------------------------
+   --------------------------------
+   -- Propagate_Concurrent_Flags --
+   --------------------------------
 
-   procedure Propagate_Type_Has_Flags
+   procedure Propagate_Concurrent_Flags
      (Typ      : Entity_Id;
       Comp_Typ : Entity_Id) is
    begin
@@ -18378,7 +18378,7 @@ package body Sem_Util is
       if Has_Timing_Event (Comp_Typ) then
          Set_Has_Timing_Event (Typ);
       end if;
-   end Propagate_Type_Has_Flags;
+   end Propagate_Concurrent_Flags;
 
    ---------------------------------------
    -- Record_Possible_Part_Of_Reference --
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a1e703f..b953669 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2008,7 +2008,7 @@ package Sem_Util is
    --  parameter Ent gives the entity to which the End_Label refers,
    --  and to which cross-references are to be generated.
 
-   procedure Propagate_Type_Has_Flags
+   procedure Propagate_Concurrent_Flags
      (Typ      : Entity_Id;
       Comp_Typ : Entity_Id);
    --  Set Has_Task, Has_Protected and Has_Timing_Event on Typ when the flags