[multiple changes]

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

	* einfo.adb, einfo.ads (Has_Timing_Event,
	Set_Has_Timing_Event): Add Has_Timing_Event flag.
	(Write_Entity_Flags): Display * sem_util.ads, sem_util.adb:
	(Propagate_Type_Has_Flags): New procedure to factorize code.
	* exp_ch3.adb (Expand_Freeze_Array_Type,
	Expand_Freeze_Record_Type): Call Propagate_Type_Has_Flags.
	* sem_ch3.adb (Access_Type_Decalaration): Initialize
	Has_Timing_Event flag.	(Analyze_Object_Declaration):
	Move code that check No_Local_Timing_Events near
	the code that check No_Local_Protected_Objects.
	(Analyze_Private_Extension_Declaration, Array_Type_Declaration)
	(Build_Derived_Type, Copy_Array_Base_Type_Attributes,
	Process_Full_View) (Record_Type_Definition): Call
	Propagate_Type_Has_Flags.
	* sem_ch4.adb (Analyze_Allocator): Check No_Local_Timing_Events.
	* sem_ch7.adb (New_Private_Type): Set Has_Timing_Event on the
	Timing_Event type.
	(Uninstall_Declaration): Call Propagate_Type_Has_Flags.
	* sem_ch9.adb (Analyze_Protected_Definition): Call
	Propagate_Type_Has_Flags.

2016-06-14  Arnaud Charlet  <charlet@adacore.com>

	* sem.ads: Minor style fix.

From-SVN: r237434

11 files changed, 137 insertions, 62 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 80537b6..479c7f0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2016-06-14  Tristan Gingold  <gingold@adacore.com>
+
+	* einfo.adb, einfo.ads (Has_Timing_Event,
+	Set_Has_Timing_Event): Add Has_Timing_Event flag.
+	(Write_Entity_Flags): Display * sem_util.ads, sem_util.adb:
+	(Propagate_Type_Has_Flags): New procedure to factorize code.
+	* exp_ch3.adb (Expand_Freeze_Array_Type,
+	Expand_Freeze_Record_Type): Call Propagate_Type_Has_Flags.
+	* sem_ch3.adb (Access_Type_Decalaration): Initialize
+	Has_Timing_Event flag.	(Analyze_Object_Declaration):
+	Move code that check No_Local_Timing_Events near
+	the code that check No_Local_Protected_Objects.
+	(Analyze_Private_Extension_Declaration, Array_Type_Declaration)
+	(Build_Derived_Type, Copy_Array_Base_Type_Attributes,
+	Process_Full_View) (Record_Type_Definition): Call
+	Propagate_Type_Has_Flags.
+	* sem_ch4.adb (Analyze_Allocator): Check No_Local_Timing_Events.
+	* sem_ch7.adb (New_Private_Type): Set Has_Timing_Event on the
+	Timing_Event type.
+	(Uninstall_Declaration): Call Propagate_Type_Has_Flags.
+	* sem_ch9.adb (Analyze_Protected_Definition): Call
+	Propagate_Type_Has_Flags.
+
+2016-06-14  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem.ads: Minor style fix.
+
 2016-06-14  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch12.adb (Analyze_Associations): An actual parameter
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index f215564..8f4a134 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -601,10 +601,21 @@ package body Einfo is
    --    Is_Exception_Handler            Flag286
    --    Rewritten_For_C                 Flag287
    --    Predicates_Ignored              Flag288
+   --    Has_Timing_Event                Flag289
 
-   --    (unused)                        Flag289
-   --    (unused)                        Flag300
+   --    (unused)                        Flag290
+
+   --    (unused)                        Flag291
+   --    (unused)                        Flag292
+   --    (unused)                        Flag293
+   --    (unused)                        Flag294
+   --    (unused)                        Flag295
+   --    (unused)                        Flag296
+   --    (unused)                        Flag297
+   --    (unused)                        Flag298
+   --    (unused)                        Flag299
 
+   --    (unused)                        Flag300
    --    (unused)                        Flag301
    --    (unused)                        Flag302
    --    (unused)                        Flag303
@@ -1879,6 +1890,11 @@ package body Einfo is
       return Flag228 (Id);
    end Has_Thunks;
 
+   function Has_Timing_Event (Id : E) return B is
+   begin
+      return Flag289 (Base_Type (Id));
+   end Has_Timing_Event;
+
    function Has_Unchecked_Union (Id : E) return B is
    begin
       return Flag123 (Base_Type (Id));
@@ -4867,6 +4883,11 @@ package body Einfo is
       Set_Flag228 (Id, V);
    end Set_Has_Thunks;
 
+   procedure Set_Has_Timing_Event (Id : E; V : B := True) is
+   begin
+      Set_Flag289 (Id, V);
+   end Set_Has_Timing_Event;
+
    procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
    begin
       pragma Assert (Id = Base_Type (Id));
@@ -8972,6 +8993,7 @@ package body Einfo is
       W ("Has_Storage_Size_Clause",         Flag23  (Id));
       W ("Has_Stream_Size_Clause",          Flag184 (Id));
       W ("Has_Task",                        Flag30  (Id));
+      W ("Has_Timing_Event",                Flag289 (Id));
       W ("Has_Thunks",                      Flag228 (Id));
       W ("Has_Unchecked_Union",             Flag123 (Id));
       W ("Has_Unknown_Discriminants",       Flag72  (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index c8b9469..405455d 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2050,6 +2050,12 @@ package Einfo is
 --       such an object must create the required tasks. Note: the flag is not
 --       set on access types, even if they designate an object that Has_Task.
 
+--    Has_Timing_Event (Flag289) [base type only]
+--       Defined in all type entities. Set on language defined type
+--       Ada.Real_Time.Timing_Events.Timing_Event, and also (recursively) on
+--       any composite type which has a component for which Has_Timing_Event
+--       is set. Used for the No_Local_Timing_Event restriction.
+
 --    Has_Thunks (Flag228)
 --       Applies to E_Constant entities marked Is_Tag. True for secondary tag
 --       referencing a dispatch table whose contents are pointers to thunks.
@@ -5507,6 +5513,7 @@ package Einfo is
    --    Has_Static_Predicate                (Flag269)
    --    Has_Static_Predicate_Aspect         (Flag259)
    --    Has_Task                            (Flag30)   (base type only)
+   --    Has_Timing_Event                    (Flag289)  (base type only)
    --    Has_Unchecked_Union                 (Flag123)  (base type only)
    --    Has_Volatile_Components             (Flag87)   (base type only)
    --    In_Use                              (Flag8)
@@ -6960,6 +6967,7 @@ package Einfo is
    function Has_Storage_Size_Clause             (Id : E) return B;
    function Has_Stream_Size_Clause              (Id : E) return B;
    function Has_Task                            (Id : E) return B;
+   function Has_Timing_Event                    (Id : E) return B;
    function Has_Thunks                          (Id : E) return B;
    function Has_Unchecked_Union                 (Id : E) return B;
    function Has_Unknown_Discriminants           (Id : E) return B;
@@ -7629,6 +7637,7 @@ package Einfo is
    procedure Set_Has_Storage_Size_Clause         (Id : E; V : B := True);
    procedure Set_Has_Stream_Size_Clause          (Id : E; V : B := True);
    procedure Set_Has_Task                        (Id : E; V : B := True);
+   procedure Set_Has_Timing_Event                (Id : E; V : B := True);
    procedure Set_Has_Thunks                      (Id : E; V : B := True);
    procedure Set_Has_Unchecked_Union             (Id : E; V : B := True);
    procedure Set_Has_Unknown_Discriminants       (Id : E; V : B := True);
@@ -8413,6 +8422,7 @@ package Einfo is
    pragma Inline (Has_Storage_Size_Clause);
    pragma Inline (Has_Stream_Size_Clause);
    pragma Inline (Has_Task);
+   pragma Inline (Has_Timing_Event);
    pragma Inline (Has_Thunks);
    pragma Inline (Has_Unchecked_Union);
    pragma Inline (Has_Unknown_Discriminants);
@@ -8922,6 +8932,7 @@ package Einfo is
    pragma Inline (Set_Has_Storage_Size_Clause);
    pragma Inline (Set_Has_Stream_Size_Clause);
    pragma Inline (Set_Has_Task);
+   pragma Inline (Set_Has_Timing_Event);
    pragma Inline (Set_Has_Thunks);
    pragma Inline (Set_Has_Unchecked_Union);
    pragma Inline (Set_Has_Unknown_Discriminants);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 18249d8..b507417 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4612,13 +4612,12 @@ package body Exp_Ch3 is
          --  been a private type at the point of definition. Same if component
          --  type is controlled or contains protected objects.
 
-         Set_Has_Task       (Base, Has_Task      (Comp_Typ));
-         Set_Has_Protected  (Base, Has_Protected (Comp_Typ));
+         Propagate_Type_Has_Flags (Base, Comp_Typ);
          Set_Has_Controlled_Component
-                            (Base, Has_Controlled_Component
+                              (Base, Has_Controlled_Component
                                                  (Comp_Typ)
-                                     or else
-                                   Is_Controlled (Comp_Typ));
+                                       or else
+                                     Is_Controlled (Comp_Typ));
 
          if No (Init_Proc (Base)) then
 
@@ -5185,13 +5184,7 @@ package body Exp_Ch3 is
       while Present (Comp) loop
          Comp_Typ := Etype (Comp);
 
-         if Has_Task (Comp_Typ) then
-            Set_Has_Task (Typ);
-         end if;
-
-         if Has_Protected (Comp_Typ) then
-            Set_Has_Protected (Typ);
-         end if;
+         Propagate_Type_Has_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.ads b/gcc/ada/sem.ads
index 22da223..c52f6b4 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -122,7 +122,7 @@
 --        xx : x := y * z;
 --      end record;
 
---      for x'small use 0.25
+--      for x'small use 0.25;
 
 --  The expander is in charge of dealing with fixed-point, and of course the
 --  small declaration, which is not too late, since the declaration of type q
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 17ac948..9f13bd9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1437,8 +1437,9 @@ package body Sem_Ch3 is
       --  and to Has_Protected.
 
       Set_Has_Task                 (T, False);
-      Set_Has_Controlled_Component (T, False);
       Set_Has_Protected            (T, False);
+      Set_Has_Timing_Event         (T, False);
+      Set_Has_Controlled_Component (T, False);
 
       --  Initialize field Finalization_Master explicitly to Empty, to avoid
       --  problems where an incomplete view of this entity has been previously
@@ -3585,6 +3586,12 @@ package body Sem_Ch3 is
          end if;
       end if;
 
+      --  Check for violation of No_Local_Timing_Events
+
+      if Has_Timing_Event (T) and then not Is_Library_Level_Entity (Id) then
+         Check_Restriction (No_Local_Timing_Events, Id);
+      end if;
+
       --  The actual subtype of the object is the nominal subtype, unless
       --  the nominal one is unconstrained and obtained from the expression.
 
@@ -4362,15 +4369,6 @@ package body Sem_Ch3 is
          Set_In_Private_Part (Id);
       end if;
 
-      --  Check for violation of No_Local_Timing_Events
-
-      if Restriction_Check_Required (No_Local_Timing_Events)
-        and then not Is_Library_Level_Entity (Id)
-        and then Is_RTE (Etype (Id), RE_Timing_Event)
-      then
-         Check_Restriction (No_Local_Timing_Events, N);
-      end if;
-
    <<Leave>>
       --  Initialize the refined state of a variable here because this is a
       --  common destination for legal and illegal object declarations.
@@ -4515,9 +4513,8 @@ package body Sem_Ch3 is
       Init_Size_Align      (T);
       Set_Default_SSO      (T);
 
-      Set_Etype            (T,            Parent_Base);
-      Set_Has_Task         (T, Has_Task  (Parent_Base));
-      Set_Has_Protected    (T, Has_Task  (Parent_Base));
+      Set_Etype            (T,                Parent_Base);
+      Propagate_Type_Has_Flags (T, Parent_Base);
 
       Set_Convention       (T, Convention     (Parent_Type));
       Set_First_Rep_Item   (T, First_Rep_Item (Parent_Type));
@@ -5576,8 +5573,7 @@ package body Sem_Ch3 is
 
          Set_First_Index       (Implicit_Base, First_Index (T));
          Set_Component_Type    (Implicit_Base, Element_Type);
-         Set_Has_Task          (Implicit_Base, Has_Task (Element_Type));
-         Set_Has_Protected     (Implicit_Base, Has_Protected (Element_Type));
+         Propagate_Type_Has_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,
@@ -5603,8 +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);
-         Set_Has_Task                 (T, Has_Task      (Element_Type));
-         Set_Has_Protected            (T, Has_Protected (Element_Type));
+         Propagate_Type_Has_Flags     (T, Element_Type);
          Set_Has_Controlled_Component (T, Has_Controlled_Component
                                                         (Element_Type)
                                             or else
@@ -8951,12 +8946,11 @@ package body Sem_Ch3 is
    begin
       --  Set common attributes
 
-      Set_Scope              (Derived_Type, Current_Scope);
+      Set_Scope                (Derived_Type, Current_Scope);
 
-      Set_Etype              (Derived_Type,                Parent_Base);
-      Set_Ekind              (Derived_Type, Ekind         (Parent_Base));
-      Set_Has_Task           (Derived_Type, Has_Task      (Parent_Base));
-      Set_Has_Protected      (Derived_Type, Has_Protected (Parent_Base));
+      Set_Etype                (Derived_Type,                Parent_Base);
+      Set_Ekind                (Derived_Type, Ekind         (Parent_Base));
+      Propagate_Type_Has_Flags (Derived_Type, Parent_Base);
 
       Set_Size_Info          (Derived_Type,                     Parent_Type);
       Set_RM_Size            (Derived_Type, RM_Size            (Parent_Type));
@@ -13713,8 +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));
-      Set_Has_Protected            (T1, Has_Protected            (T2));
-      Set_Has_Task                 (T1, Has_Task                 (T2));
+      Propagate_Type_Has_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));
@@ -19931,9 +19924,7 @@ package body Sem_Ch3 is
                Set_Class_Wide_Type
                  (Base_Type (Full_T), Class_Wide_Type (Priv_T));
 
-               Set_Has_Task (Class_Wide_Type (Priv_T), Has_Task      (Full_T));
-               Set_Has_Protected
-                            (Class_Wide_Type (Priv_T), Has_Protected (Full_T));
+               Propagate_Type_Has_Flags (Class_Wide_Type (Priv_T), Full_T);
             end if;
          end;
       end if;
@@ -21289,13 +21280,7 @@ package body Sem_Ch3 is
             Init_Component_Location (Component);
          end if;
 
-         if Has_Task (Etype (Component)) then
-            Set_Has_Task (T);
-         end if;
-
-         if Has_Protected (Etype (Component)) then
-            Set_Has_Protected (T);
-         end if;
+         Propagate_Type_Has_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 33e3091..20d1a74 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -812,6 +812,14 @@ package body Sem_Ch4 is
          Check_Restriction (No_Local_Protected_Objects, N);
       end if;
 
+      --  Likewise for No_Local_Timing_Events
+
+      if Has_Timing_Event (Designated_Type (Acc_Type))
+        and then not Is_Library_Level_Entity (Acc_Type)
+      then
+         Check_Restriction (No_Local_Timing_Events, N);
+      end if;
+
       --  If the No_Streams restriction is set, check that the type of the
       --  object is not, and does not contain, any subtype derived from
       --  Ada.Streams.Root_Stream_Type. Note that we guard the call to
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 1a8786d..bb47589 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -47,6 +47,7 @@ with Nlists;    use Nlists;
 with Opt;       use Opt;
 with Output;    use Output;
 with Restrict;  use Restrict;
+with Rtsfind;   use Rtsfind;
 with Sem;       use Sem;
 with Sem_Aux;   use Sem_Aux;
 with Sem_Cat;   use Sem_Cat;
@@ -2446,6 +2447,12 @@ package body Sem_Ch7 is
          Set_Is_Limited_Record           (Id, Limited_Present (Def));
          Set_Has_Delayed_Freeze          (Id, True);
 
+         --  Recognize Ada.Real_Time.Timing_Events.Timing_Events here
+
+         if Is_RTE (Id, RE_Timing_Event) then
+            Set_Has_Timing_Event (Id);
+         end if;
+
          --  Create a class-wide type with the same attributes
 
          Make_Class_Wide_Type (Id);
@@ -2578,8 +2585,8 @@ package body Sem_Ch7 is
             Set_Finalize_Storage_Only
                               (Priv, Finalize_Storage_Only
                                                    (Base_Type (Full)));
-            Set_Has_Task      (Priv, Has_Task      (Base_Type (Full)));
-            Set_Has_Protected (Priv, Has_Protected (Base_Type (Full)));
+            Propagate_Type_Has_Flags
+                              (Priv, Base_Type (Full));
             Set_Has_Controlled_Component
                               (Priv, Has_Controlled_Component
                                                    (Base_Type (Full)));
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 442a71d..adfd27d 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1937,16 +1937,8 @@ package body Sem_Ch9 is
       while Present (E) loop
          if Ekind_In (E, E_Function, E_Procedure) then
             Set_Convention (E, Convention_Protected);
-
-         elsif Is_Task_Type (Etype (E))
-           or else Has_Task (Etype (E))
-         then
-            Set_Has_Task (Current_Scope);
-
-         elsif Is_Protected_Type (Etype (E))
-           or else Has_Protected (Etype (E))
-         then
-            Set_Has_Protected (Current_Scope);
+         else
+            Propagate_Type_Has_Flags (Current_Scope, Etype (E));
          end if;
 
          Next_Entity (E);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5dbaccd..6237d7b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18300,6 +18300,27 @@ package body Sem_Util is
       Set_Sloc (Endl, Loc);
    end Process_End_Label;
 
+   ------------------------------
+   -- Propagate_Type_Has_Flags --
+   ------------------------------
+
+   procedure Propagate_Type_Has_Flags
+     (Typ      : Entity_Id;
+      Comp_Typ : Entity_Id) is
+   begin
+      if Has_Task (Comp_Typ) then
+         Set_Has_Task (Typ);
+      end if;
+
+      if Has_Protected (Comp_Typ) then
+         Set_Has_Protected (Typ);
+      end if;
+
+      if Has_Timing_Event (Comp_Typ) then
+         Set_Has_Timing_Event (Typ);
+      end if;
+   end Propagate_Type_Has_Flags;
+
    ---------------------------------------
    -- Record_Possible_Part_Of_Reference --
    ---------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c7fdc81..d0e3d4e 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2003,6 +2003,15 @@ 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
+     (Typ      : Entity_Id;
+      Comp_Typ : Entity_Id);
+   --  Set Has_Task, Has_Protected and Has_Timing_Event on Typ when the flags
+   --  are set on Comp_Typ. This follows the definition of these flags which
+   --  are set (recursively) on any composite type which has a component marked
+   --  by one of these flags. This procedure can only set flags for Typ, and
+   --  never clear them. Comp_Typ is the type of a component or a parent.
+
    procedure Record_Possible_Part_Of_Reference
      (Var_Id : Entity_Id;
       Ref    : Node_Id);