[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 14 Jun 2016 12:41:03 +0000 (14:41 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 14 Jun 2016 12:41:03 +0000 (14:41 +0200)
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

gcc/ada/ChangeLog
gcc/ada/einfo.adb
gcc/ada/exp_ch3.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_ch9.adb
gcc/ada/sem_elab.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index ef70ce53fd6ec4ad1bd9417eb7e96088cc81adcc..ebdf963de00d6a9fd3709ec5a0d461b161297ca8 100644 (file)
@@ -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
index 8f4a1347615a38ed84296ed9e0276aaa63394953..f812026ce7544e15eef20eb1db2449c48af73d33 100644 (file)
@@ -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;
 
index 7f98b91d23d8543d8fbb0f95b36966c9cc5fffb5..06252736c7e57b3f33aa64c02b960356bd588e4c 100644 (file)
@@ -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.
index 9f13bd9d031a17ff9344dff4a9123815e9357f51..4e5b8f7f9ae7db13a091f99092d64ceb28257504 100644 (file)
@@ -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;
index edcfee226d50d5602f247fdb53022ef649351664..a109cd0c50c3e4f7d20782f2012c4c20d72ddca5 100644 (file)
@@ -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
index a6ac2920076666b2ca813679ed3569714bc4c81b..4f7efc30ff1d46714700871b1f6f48dd48a07bd3 100644 (file)
@@ -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);
index 8c318fddc73d8d9fc3a3540359a9550944c24ca6..0c235f624dbcd34a15407c104ea479d71fc46ff3 100644 (file)
@@ -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
index adfd27d0e981ab0661188ade0bb688793e5d313b..aa2a18de79266b633e39fd60f118e54d8c0cbda5 100644 (file)
@@ -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);
index 27fed6f0a477d8259919f01fc5bc502cf3fef6c1..480544004645713f05aad0ac1a28fbede73c4663 100644 (file)
@@ -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;
index 020e6d739ce00ae50f344ed92181e219a43e733b..c39e3a665459db8927f98eeece0a3a94804e66ef 100644 (file)
@@ -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 --
index a1e703fbba9dac5dcf21a985681c6d442c2d73c7..b95366962e3b94c54177af97e53dc9ba31c7a3f7 100644 (file)
@@ -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