[Ada] Crash in tagged type constructor with task components

2020-06-15  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* restrict.ads (Set_Global_No_Tasking, Global_No_Tasking): New
	subprograms.
	* restrict.adb (Set_Global_No_Tasking, Global_No_Tasking): New
	subprograms.
	* sem_ch3.adb (Access_Definition): Do not skip building masters
	since they may be required for BIP calls.
	(Analyze_Subtype_Declaration): Propagate attribute
	Is_Limited_Record in class-wide subtypes and subtypes with
	cloned subtype attribute; propagate attribute
	Is_Limited_Interface.
	* sem_ch6.adb (Check_Anonymous_Return): Do not skip building
	masters since they may be required for BIP calls. Use
	Build_Master_Declaration to declare the _master variable.
	(Create_Extra_Formals): Add decoration of Has_Master_Entity when
	the _master formal is added.
	* exp_ch3.adb (Init_Formals): Adding formal to decorate it with
	attribute Has_Master_Entity when the _master formal is added.
	(Build_Master): Do not skip building masters since they may be
	required for BIP calls.
	(Expand_N_Object_Declaration): Ensure activation chain and
	master entity for objects initialized with BIP function calls.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Adding support to detect and save restriction No_Tasking when
	set in the run-time package System or in a global configuration
	pragmas file.
	* sem_util.adb (Current_Entity_In_Scope): Overload this
	subprogram to allow searching for an entity by its Name.
	* sem_util.ads (Current_Entity_In_Scope): Update comment.
	* exp_ch4.adb (Expand_N_Allocator): Do not skip building masters
	since they may be required for BIP calls.
	* exp_ch6.ads (Might_Have_Tasks): New subprogram.
	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add
	support for BIP calls returning objects that may have tasks.
	(Make_Build_In_Place_Call_In_Allocator): Build the activation
	chain if the result might have tasks.
	(Make_Build_In_Place_Iface_Call_In_Allocator): Build the class
	wide master for the result type.
	(Might_Have_Tasks): New subprogram.
	(Needs_BIP_Task_Actuals): Returns False when restriction
	No_Tasking is globally set.
	* exp_ch9.ads (Build_Master_Declaration): New subprogram.
	* exp_ch9.adb (Build_Activation_Chain_Entity): No action
	performed when restriction No_Tasking is globally set.
	(Build_Class_Wide_Master): No action performed when restriction
	No_Tasking is globally set; use Build_Master_Declaration to
	declare the _master variable.
	(Build_Master_Declaration): New subprogram.
	(Build_Master_Entity): No action performed when restriction
	No_Tasking is globally set; added support to handle transient
	scopes and _finalizer routines.
	(Build_Master_Renaming): No action performed when restriction
	No_Tasking is globally set.
	(Build_Task_Activation_Call): Skip generating the call when
	the chain is an ignored ghost entity.
	(Find_Master_Scope): Generalize the code that detects transient
	scopes with master entity.
	* einfo.ads (Has_Nested_Subprogram): Minor comment reformatting.

14 files changed, 299 insertions, 100 deletions

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 346a15e..35efe59 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1813,8 +1813,8 @@ package Einfo is
 --       See documentation in backend for further details.
 
 --    Has_Nested_Subprogram (Flag282)
---      Defined in subprogram entities. Set for a subprogram which contains at
---      least one nested subprogram.
+--       Defined in subprogram entities. Set for a subprogram which contains at
+--       least one nested subprogram.
 
 --    Has_Non_Limited_View (synth)
 --       Defined in E_Incomplete_Type, E_Incomplete_Subtype, E_Class_Wide_Type,
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7d13cd6..b207a1f 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -184,11 +184,11 @@ package body Exp_Ch3 is
    --  E is a type, it has components that have no static initialization.
    --  if E is an entity, its initial expression is not compile-time known.
 
-   function Init_Formals (Typ : Entity_Id) return List_Id;
+   function Init_Formals (Typ : Entity_Id; Proc_Id : Entity_Id) return List_Id;
    --  This function builds the list of formals for an initialization routine.
    --  The first formal is always _Init with the given type. For task value
    --  record types and types containing tasks, three additional formals are
-   --  added:
+   --  added and Proc_Id is decorated with attribute Has_Master_Entity:
    --
    --    _Master    : Master_Id
    --    _Chain     : in out Activation_Chain
@@ -730,7 +730,7 @@ package body Exp_Ch3 is
          end if;
 
          Body_Stmts := Init_One_Dimension (1);
-         Parameters := Init_Formals (A_Type);
+         Parameters := Init_Formals (A_Type, Proc_Id);
 
          Discard_Node (
            Make_Subprogram_Body (Loc,
@@ -2438,7 +2438,7 @@ package body Exp_Ch3 is
          Proc_Spec_Node := New_Node (N_Procedure_Specification, Loc);
          Set_Defining_Unit_Name (Proc_Spec_Node, Proc_Id);
 
-         Parameters := Init_Formals (Rec_Type);
+         Parameters := Init_Formals (Rec_Type, Proc_Id);
          Append_List_To (Parameters,
            Build_Discriminant_Formals (Rec_Type, True));
 
@@ -5720,7 +5720,7 @@ package body Exp_Ch3 is
          --  record parameter for an entry declaration. No master is created
          --  for such a type.
 
-         if Comes_From_Source (N) and then Has_Task (Desig_Typ) then
+         if Has_Task (Desig_Typ) then
             Build_Master_Entity (Ptr_Typ);
             Build_Master_Renaming (Ptr_Typ);
 
@@ -5734,12 +5734,11 @@ package body Exp_Ch3 is
          --  Suppress the master creation for access types created for entry
          --  formal parameters (parameter block component types). Seems like
          --  suppression should be more general for compiler-generated types,
-         --  but testing Comes_From_Source, like the code above does, may be
-         --  too general in this case (affects some test output)???
+         --  but testing Comes_From_Source may be too general in this case
+         --  (affects some test output)???
 
          elsif not Is_Param_Block_Component_Type (Ptr_Typ)
            and then Is_Limited_Class_Wide_Type (Desig_Typ)
-           and then Tasking_Allowed
          then
             Build_Class_Wide_Master (Ptr_Typ);
          end if;
@@ -6666,14 +6665,39 @@ package body Exp_Ch3 is
          Init_After := Make_Shared_Var_Procs (N);
       end if;
 
-      --  If tasks being declared, make sure we have an activation chain
+      --  If tasks are being declared, make sure we have an activation chain
       --  defined for the tasks (has no effect if we already have one), and
-      --  also that a Master variable is established and that the appropriate
-      --  enclosing construct is established as a task master.
+      --  also that a Master variable is established (and that the appropriate
+      --  enclosing construct is established as a task master).
 
-      if Has_Task (Typ) then
+      if Has_Task (Typ) or else Might_Have_Tasks (Typ) then
          Build_Activation_Chain_Entity (N);
-         Build_Master_Entity (Def_Id);
+
+         if Has_Task (Typ) then
+            Build_Master_Entity (Def_Id);
+
+         --  Handle objects initialized with BIP function calls
+
+         elsif Present (Expr) then
+            declare
+               Expr_Q : Node_Id := Expr;
+
+            begin
+               if Nkind (Expr) = N_Qualified_Expression then
+                  Expr_Q := Expression (Expr);
+               end if;
+
+               if Is_Build_In_Place_Function_Call (Expr_Q)
+                 or else Present (Unqual_BIP_Iface_Function_Call (Expr_Q))
+                 or else
+                   (Nkind (Expr_Q) = N_Reference
+                      and then
+                    Is_Build_In_Place_Function_Call (Prefix (Expr_Q)))
+               then
+                  Build_Master_Entity (Def_Id);
+               end if;
+            end;
+         end if;
       end if;
 
       --  If No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations
@@ -6691,7 +6715,7 @@ package body Exp_Ch3 is
       --  of the stacks in this scenario, the stacks of the first array are
       --  not counted.
 
-      if Has_Task (Typ)
+      if (Has_Task (Typ) or else Might_Have_Tasks (Typ))
         and then not Restriction_Active (No_Secondary_Stack)
         and then (Restriction_Active (No_Implicit_Heap_Allocations)
           or else Restriction_Active (No_Implicit_Task_Allocations))
@@ -8862,7 +8886,8 @@ package body Exp_Ch3 is
    -- Init_Formals --
    ------------------
 
-   function Init_Formals (Typ : Entity_Id) return List_Id is
+   function Init_Formals (Typ : Entity_Id; Proc_Id : Entity_Id) return List_Id
+   is
       Loc        : constant Source_Ptr := Sloc (Typ);
       Unc_Arr    : constant Boolean :=
                      Is_Array_Type (Typ) and then not Is_Constrained (Typ);
@@ -8871,9 +8896,11 @@ package body Exp_Ch3 is
                        or else (Is_Record_Type (Typ)
                                  and then Is_Protected_Record_Type (Typ));
       With_Task  : constant Boolean :=
-                     Has_Task (Typ)
-                       or else (Is_Record_Type (Typ)
-                                 and then Is_Task_Record_Type (Typ));
+                     not Global_No_Tasking
+                       and then
+                     (Has_Task (Typ)
+                        or else (Is_Record_Type (Typ)
+                                   and then Is_Task_Record_Type (Typ)));
       Formals : List_Id;
 
    begin
@@ -8902,6 +8929,8 @@ package body Exp_Ch3 is
              Parameter_Type      =>
                New_Occurrence_Of (RTE (RE_Master_Id), Loc)));
 
+         Set_Has_Master_Entity (Proc_Id);
+
          --  Add _Chain (not done for sequential elaboration policy, see
          --  comment for Create_Restricted_Task_Sequential in s-tarest.ads).
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index bf88225..27410ff 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5031,20 +5031,18 @@ package body Exp_Ch4 is
                      --  The designated type was an incomplete type, and the
                      --  access type did not get expanded. Salvage it now.
 
-                     if not Restriction_Active (No_Task_Hierarchy) then
-                        if Present (Parent (Base_Type (PtrT))) then
-                           Expand_N_Full_Type_Declaration
-                             (Parent (Base_Type (PtrT)));
+                     if Present (Parent (Base_Type (PtrT))) then
+                        Expand_N_Full_Type_Declaration
+                          (Parent (Base_Type (PtrT)));
 
-                        --  The only other possibility is an itype. For this
-                        --  case, the master must exist in the context. This is
-                        --  the case when the allocator initializes an access
-                        --  component in an init-proc.
+                     --  The only other possibility is an itype. For this
+                     --  case, the master must exist in the context. This is
+                     --  the case when the allocator initializes an access
+                     --  component in an init-proc.
 
-                        else
-                           pragma Assert (Is_Itype (PtrT));
-                           Build_Master_Renaming (PtrT, N);
-                        end if;
+                     else
+                        pragma Assert (Is_Itype (PtrT));
+                        Build_Master_Renaming (PtrT, N);
                      end if;
                   end if;
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index b2b81ee..1dd4493 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -8616,7 +8616,7 @@ package body Exp_Ch6 is
          --  rather than some outer chain.
 
       begin
-         if Has_Task (Result_Subt) then
+         if Has_Task (Result_Subt) or else Might_Have_Tasks (Result_Subt) then
             Actions := New_List;
             Build_Task_Allocate_Block_With_Init_Stmts
               (Actions, Allocator, Init_Stmts => New_List (Assign));
@@ -9393,6 +9393,7 @@ package body Exp_Ch6 is
       Anon_Type := Create_Itype (E_Anonymous_Access_Type, Function_Call);
       Set_Directly_Designated_Type (Anon_Type, Etype (BIP_Func_Call));
       Set_Etype (Anon_Type, Anon_Type);
+      Build_Class_Wide_Master (Anon_Type);
 
       Tmp_Decl :=
         Make_Object_Declaration (Loc,
@@ -9627,6 +9628,18 @@ package body Exp_Ch6 is
       Analyze_And_Resolve (Allocator, Acc_Type);
    end Make_CPP_Constructor_Call_In_Allocator;
 
+   ----------------------
+   -- Might_Have_Tasks --
+   ----------------------
+
+   function Might_Have_Tasks (Typ : Entity_Id) return Boolean is
+   begin
+      return not Global_No_Tasking
+        and then not No_Run_Time_Mode
+        and then Is_Class_Wide_Type (Typ)
+        and then Is_Limited_Record (Typ);
+   end Might_Have_Tasks;
+
    ----------------------------
    -- Needs_BIP_Task_Actuals --
    ----------------------------
@@ -9635,7 +9648,8 @@ package body Exp_Ch6 is
       pragma Assert (Is_Build_In_Place_Function (Func_Id));
       Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
    begin
-      return Has_Task (Func_Typ);
+      return not Global_No_Tasking
+        and then (Has_Task (Func_Typ) or else Might_Have_Tasks (Func_Typ));
    end Needs_BIP_Task_Actuals;
 
    -----------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index b3dae14..1c30219 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -234,6 +234,10 @@ package Exp_Ch6 is
    --  the constructor, and the allocator is rewritten to refer to that access
    --  object. Function_Call must denote a call to a CPP_Constructor function.
 
+   function Might_Have_Tasks (Typ : Entity_Id) return Boolean;
+   --  Return True if Typ is a limited class-wide type (or subtype), since it
+   --  might have task components.
+
    function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Return True if the function needs an implicit
    --  BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 5162118..da6e309 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -928,6 +928,12 @@ package body Exp_Ch9 is
    --  Start of processing for Build_Activation_Chain_Entity
 
    begin
+      --  No action needed if the run-time has no tasking support
+
+      if Global_No_Tasking then
+         return;
+      end if;
+
       --  Activation chain is never used for sequential elaboration policy, see
       --  comment for Create_Restricted_Task_Sequential in s-tarest.ads).
 
@@ -1127,9 +1133,9 @@ package body Exp_Ch9 is
       Ren_Decl     : Node_Id;
 
    begin
-      --  Nothing to do if there is no task hierarchy
+      --  No action needed if the run-time has no tasking support
 
-      if Restriction_Active (No_Task_Hierarchy) then
+      if Global_No_Tasking then
          return;
       end if;
 
@@ -1168,21 +1174,7 @@ package body Exp_Ch9 is
       then
          begin
             Set_Has_Master_Entity (Master_Scope);
-
-            --  Generate:
-            --    _master : constant Integer := Current_Master.all;
-
-            Master_Decl :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier =>
-                  Make_Defining_Identifier (Loc, Name_uMaster),
-                Constant_Present    => True,
-                Object_Definition   =>
-                  New_Occurrence_Of (Standard_Integer, Loc),
-                Expression          =>
-                  Make_Explicit_Dereference (Loc,
-                    New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
-
+            Master_Decl := Build_Master_Declaration (Loc);
             Insert_Action (Find_Hook_Context (Related_Node), Master_Decl);
             Analyze (Master_Decl);
 
@@ -1695,6 +1687,65 @@ package body Exp_Ch9 is
       return Ecount;
    end Build_Entry_Count_Expression;
 
+   ------------------------------
+   -- Build_Master_Declaration --
+   ------------------------------
+
+   function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id is
+      Master_Decl : Node_Id;
+
+   begin
+      --  Generate a dummy master if tasks or tasking hierarchies are
+      --  prohibited.
+
+      --    _Master : constant Master_Id := 3;
+
+      if not Tasking_Allowed
+        or else Restrictions.Set (No_Task_Hierarchy)
+        or else not RTE_Available (RE_Current_Master)
+      then
+         declare
+            Expr : Node_Id;
+
+         begin
+            --  RE_Library_Task_Level is not always available in configurable
+            --  RunTime
+
+            if not RTE_Available (RE_Library_Task_Level) then
+               Expr := Make_Integer_Literal (Loc, Uint_3);
+            else
+               Expr := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc);
+            end if;
+
+            Master_Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Loc, Name_uMaster),
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Integer, Loc),
+                Expression          => Expr);
+         end;
+
+      --  Generate:
+      --    _master : constant Integer := Current_Master.all;
+
+      else
+         Master_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier =>
+               Make_Defining_Identifier (Loc, Name_uMaster),
+             Constant_Present    => True,
+             Object_Definition   =>
+               New_Occurrence_Of (Standard_Integer, Loc),
+             Expression          =>
+               Make_Explicit_Dereference (Loc,
+                 New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
+      end if;
+
+      return Master_Decl;
+   end Build_Master_Declaration;
+
    ---------------------------
    -- Build_Parameter_Block --
    ---------------------------
@@ -3345,12 +3396,40 @@ package body Exp_Ch9 is
       Par        : Node_Id;
 
    begin
+      --  No action needed if the run-time has no tasking support
+
+      if Global_No_Tasking then
+         return;
+      end if;
+
       if Is_Itype (Obj_Or_Typ) then
          Par := Associated_Node_For_Itype (Obj_Or_Typ);
       else
          Par := Parent (Obj_Or_Typ);
       end if;
 
+      --  For transient scopes check if the master entity is already defined
+
+      if Is_Type (Obj_Or_Typ)
+        and then Ekind (Scope (Obj_Or_Typ)) = E_Block
+        and then Is_Internal (Scope (Obj_Or_Typ))
+      then
+         declare
+            Master_Scope : constant Entity_Id :=
+                             Find_Master_Scope (Obj_Or_Typ);
+         begin
+            if Has_Master_Entity (Master_Scope)
+              or else Is_Finalizer (Master_Scope)
+            then
+               return;
+            end if;
+
+            if Present (Current_Entity_In_Scope (Name_uMaster)) then
+               return;
+            end if;
+         end;
+      end if;
+
       --  When creating a master for a record component which is either a task
       --  or access-to-task, the enclosing record is the master scope and the
       --  proper insertion point is the component list.
@@ -3368,31 +3447,16 @@ package body Exp_Ch9 is
          Find_Enclosing_Context (Par, Context, Context_Id, Decls);
       end if;
 
-      --  Nothing to do if the context already has a master
+      --  Nothing to do if the context already has a master; internally build
+      --  finalizers don't need a master.
 
-      if Has_Master_Entity (Context_Id) then
-         return;
-
-      --  Nothing to do if tasks or tasking hierarchies are prohibited
-
-      elsif Restriction_Active (No_Tasking)
-        or else Restriction_Active (No_Task_Hierarchy)
+      if Has_Master_Entity (Context_Id)
+        or else Is_Finalizer (Context_Id)
       then
          return;
       end if;
 
-      --  Create a master, generate:
-      --    _Master : constant Master_Id := Current_Master.all;
-
-      Decl :=
-        Make_Object_Declaration (Loc,
-          Defining_Identifier =>
-            Make_Defining_Identifier (Loc, Name_uMaster),
-          Constant_Present    => True,
-          Object_Definition   => New_Occurrence_Of (RTE (RE_Master_Id), Loc),
-          Expression          =>
-            Make_Explicit_Dereference (Loc,
-              New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
+      Decl := Build_Master_Declaration (Loc);
 
       --  The master is inserted at the start of the declarative list of the
       --  context.
@@ -3448,11 +3512,9 @@ package body Exp_Ch9 is
       Master_Id   : Entity_Id;
 
    begin
-      --  Nothing to do if tasks or tasking hierarchies are prohibited
+      --  No action needed if the run-time has no tasking support
 
-      if Restriction_Active (No_Tasking)
-        or else Restriction_Active (No_Task_Hierarchy)
-      then
+      if Global_No_Tasking then
          return;
       end if;
 
@@ -4794,9 +4856,10 @@ package body Exp_Ch9 is
       Chain := Activation_Chain_Entity (Owner);
 
       --  Nothing to do when there are no tasks to activate. This is indicated
-      --  by a missing activation chain entity.
+      --  by a missing activation chain entity; skip also generating it when
+      --  it is a ghost entity.
 
-      if No (Chain) then
+      if No (Chain) or else Is_Ignored_Ghost_Entity (Chain) then
          return;
       end if;
 
@@ -13312,8 +13375,7 @@ package body Exp_Ch9 is
       if Ada_Version >= Ada_2005 then
          while Is_Internal (S) loop
             if Nkind (Parent (S)) = N_Block_Statement
-              and then
-                Nkind (Original_Node (Parent (S))) = N_Procedure_Call_Statement
+              and then Has_Master_Entity (S)
             then
                exit;
 
diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads
index 5ba5b9f..3656ac7 100644
--- a/gcc/ada/exp_ch9.ads
+++ b/gcc/ada/exp_ch9.ads
@@ -55,6 +55,12 @@ package Exp_Ch9 is
    --  interface, ensure that the designated type has a _master and generate
    --  a renaming of the said master to service the access type.
 
+   function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id;
+   --  For targets supporting tasks generate:
+   --      _Master : constant Integer := Current_Master.all;
+   --  For targets where tasks or tasking hierarchies are prohibited generate:
+   --      _Master : constant Master_Id := 3;
+
    procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id);
    --  Given the name of an object or a type which is either a task, contains
    --  tasks or designates tasks, create a _master in the appropriate scope
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 2c812e8..ebdc7ce 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -39,6 +39,10 @@ with Uname;    use Uname;
 
 package body Restrict is
 
+   Global_Restriction_No_Tasking : Boolean := False;
+   --  Set to True when No_Tasking is set in the run-time package System
+   --  or in a configuration pragmas file (for example, gnat.adc).
+
    --------------------------------
    -- Package Local Declarations --
    --------------------------------
@@ -898,6 +902,15 @@ package body Restrict is
       return Not_A_Restriction_Id;
    end Get_Restriction_Id;
 
+   -----------------------
+   -- Global_No_Tasking --
+   -----------------------
+
+   function Global_No_Tasking return Boolean is
+   begin
+      return Global_Restriction_No_Tasking;
+   end Global_No_Tasking;
+
    -------------------------------
    -- No_Exception_Handlers_Set --
    -------------------------------
@@ -1574,6 +1587,15 @@ package body Restrict is
       No_Use_Of_Pragma_Warning (A_Id) := False;
    end Set_Restriction_No_Use_Of_Pragma;
 
+   ---------------------------
+   -- Set_Global_No_Tasking --
+   ---------------------------
+
+   procedure Set_Global_No_Tasking is
+   begin
+      Global_Restriction_No_Tasking := True;
+   end Set_Global_No_Tasking;
+
    ----------------------------------
    -- Suppress_Restriction_Message --
    ----------------------------------
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index e0c6bba..bcea115 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -422,6 +422,10 @@ package Restrict is
    --  of individual Restrictions pragmas). Returns True only if all the
    --  required restrictions are set.
 
+   procedure Set_Global_No_Tasking;
+   --  Used in call from Sem_Prag when restriction No_Tasking is set in the
+   --  run-time package System or in a configuration pragmas file.
+
    procedure Set_Profile_Restrictions
      (P    : Profile_Name;
       N    : Node_Id;
@@ -505,6 +509,10 @@ package Restrict is
    --  Tests if tasking operations are allowed by the current restrictions
    --  settings. For tasking to be allowed Max_Tasks must be non-zero.
 
+   function Global_No_Tasking return Boolean;
+   --  Returns True if the restriction No_Tasking is set in the run-time
+   --  package System or in a configuration pragmas file.
+
    ----------------------------------------------
    -- Handling of Boolean Compilation Switches --
    ----------------------------------------------
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2431b26..149776c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -924,7 +924,6 @@ package body Sem_Ch3 is
       then
          if Is_Limited_Record (Desig_Type)
            and then Is_Class_Wide_Type (Desig_Type)
-           and then Tasking_Allowed
          then
             Build_Class_Wide_Master (Anon_Type);
 
@@ -5418,6 +5417,7 @@ package body Sem_Ch3 is
                Set_Class_Wide_Type      (Id, Class_Wide_Type    (T));
                Set_Cloned_Subtype       (Id, T);
                Set_Is_Tagged_Type       (Id, True);
+               Set_Is_Limited_Record    (Id, Is_Limited_Record  (T));
                Set_Has_Unknown_Discriminants
                                         (Id, True);
                Set_No_Tagged_Streams_Pragma
@@ -5701,6 +5701,7 @@ package body Sem_Ch3 is
 
       if Is_Interface (T) then
          Set_Is_Interface (Id);
+         Set_Is_Limited_Interface (Id, Is_Limited_Interface (T));
       end if;
 
       if Present (Generic_Parent_Type (N))
@@ -12358,6 +12359,7 @@ package body Sem_Ch3 is
          --  Show Full is simply a renaming of Full_Base
 
          Set_Cloned_Subtype (Full, Full_Base);
+         Set_Is_Limited_Record (Full, Is_Limited_Record (Full_Base));
 
          --  Propagate predicates
 
@@ -12393,11 +12395,18 @@ package body Sem_Ch3 is
 
       if Is_Tagged_Type (Full_Base) then
          Set_Is_Tagged_Type (Full);
+         Set_Is_Limited_Record (Full, Is_Limited_Record (Full_Base));
+
          Set_Direct_Primitive_Operations
            (Full, Direct_Primitive_Operations (Full_Base));
          Set_No_Tagged_Streams_Pragma
            (Full, No_Tagged_Streams_Pragma (Full_Base));
 
+         if Is_Interface (Full_Base) then
+            Set_Is_Interface (Full);
+            Set_Is_Limited_Interface (Full, Is_Limited_Interface (Full_Base));
+         end if;
+
          --  Inherit class_wide type of full_base in case the partial view was
          --  not tagged. Otherwise it has already been created when the private
          --  subtype was analyzed.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 51724ff..8ded5ad 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -51,7 +51,6 @@ with Nmake;     use Nmake;
 with Opt;       use Opt;
 with Output;    use Output;
 with Restrict;  use Restrict;
-with Rident;    use Rident;
 with Rtsfind;   use Rtsfind;
 with Sem;       use Sem;
 with Sem_Aux;   use Sem_Aux;
@@ -2928,22 +2927,8 @@ package body Sem_Ch6 is
                            and then
                          Is_Limited_Record (Designated_Type (Etype (Scop)))))
            and then Expander_Active
-
-           --  Avoid cases with no tasking support
-
-           and then RTE_Available (RE_Current_Master)
-           and then not Restriction_Active (No_Task_Hierarchy)
          then
-            Decl :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier =>
-                  Make_Defining_Identifier (Loc, Name_uMaster),
-                Constant_Present => True,
-                Object_Definition =>
-                  New_Occurrence_Of (RTE (RE_Master_Id), Loc),
-                Expression =>
-                  Make_Explicit_Dereference (Loc,
-                    New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
+            Decl := Build_Master_Declaration (Loc);
 
             if Present (Declarations (N)) then
                Prepend (Decl, Declarations (N));
@@ -8566,6 +8551,9 @@ package body Sem_Ch6 is
                  Add_Extra_Formal
                    (E, RTE (RE_Master_Id),
                     E, BIP_Formal_Suffix (BIP_Task_Master));
+
+               Set_Has_Master_Entity (E);
+
                Discard :=
                  Add_Extra_Formal
                    (E, RTE (RE_Activation_Chain_Access),
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a32bb9b..eb374c4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10679,6 +10679,55 @@ package body Sem_Prag is
                   else
                      Add_To_Config_Boolean_Restrictions (No_Elaboration_Code);
                   end if;
+
+               --  Special processing for No_Tasking restriction
+
+               elsif R_Id = No_Tasking then
+
+                  --  Handle global configuration pragmas
+
+                  if No (Cunit (Main_Unit)) then
+                     Set_Global_No_Tasking;
+
+                  --  Handle package System, which may be loaded by rtsfind as
+                  --  a consequence of loading some other run-time unit.
+
+                  else
+                     declare
+                        C_Node : constant Entity_Id :=
+                                   Cunit (Current_Sem_Unit);
+                        C_Ent  : constant Entity_Id :=
+                                   Cunit_Entity (Current_Sem_Unit);
+                        Loc_Str : constant String :=
+                                    Build_Location_String (Sloc (C_Ent));
+                        Ref_Str : constant String := "system.ads";
+                        Ref_Len : constant Positive := Ref_Str'Length;
+
+                     begin
+                        pragma Assert (Loc_Str'First = 1);
+                        pragma Assert (Loc_Str'First = Ref_Str'First);
+
+                        if Nkind (Unit (C_Node)) = N_Package_Declaration
+                          and then Chars (C_Ent) = Name_System
+
+                           --  Handle child packages named foo-system.ads
+
+                          and then Loc_Str'Length > Ref_Str'Length
+                          and then Loc_Str (Loc_Str'First .. Ref_Len)
+                                     = Ref_Str (Ref_Str'First .. Ref_Len)
+
+                           --  ... and ensure that package System has not
+                           --  been previously loaded. Done to ensure that
+                           --  the above checks do not have any corner case
+                           --  (since they are performed without semantic
+                           --  information).
+
+                          and then not RTU_Loaded (Rtsfind.System)
+                        then
+                           Set_Global_No_Tasking;
+                        end if;
+                     end;
+                  end if;
                end if;
 
                --  If this is a warning, then set the warning unless we already
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 203cada..31e03fd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6119,14 +6119,14 @@ package body Sem_Util is
    -- Current_Entity_In_Scope --
    -----------------------------
 
-   function Current_Entity_In_Scope (N : Node_Id) return Entity_Id is
+   function Current_Entity_In_Scope (N : Name_Id) return Entity_Id is
       E  : Entity_Id;
       CS : constant Entity_Id := Current_Scope;
 
       Transient_Case : constant Boolean := Scope_Is_Transient;
 
    begin
-      E := Get_Name_Entity_Id (Chars (N));
+      E := Get_Name_Entity_Id (N);
       while Present (E)
         and then Scope (E) /= CS
         and then (not Transient_Case or else Scope (E) /= Scope (CS))
@@ -6137,6 +6137,15 @@ package body Sem_Util is
       return E;
    end Current_Entity_In_Scope;
 
+   -----------------------------
+   -- Current_Entity_In_Scope --
+   -----------------------------
+
+   function Current_Entity_In_Scope (N : Node_Id) return Entity_Id is
+   begin
+      return Current_Entity_In_Scope (Chars (N));
+   end Current_Entity_In_Scope;
+
    -------------------
    -- Current_Scope --
    -------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index ebc9175..a7ca0f7 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -574,9 +574,10 @@ package Sem_Util is
    --  Find the currently visible definition for a given identifier, that is to
    --  say the first entry in the visibility chain for the Chars of N.
 
+   function Current_Entity_In_Scope (N : Name_Id) return Entity_Id;
    function Current_Entity_In_Scope (N : Node_Id) return Entity_Id;
-   --  Find whether there is a previous definition for identifier N in the
-   --  current scope. Because declarations for a scope are not necessarily
+   --  Find whether there is a previous definition for name or identifier N in
+   --  the current scope. Because declarations for a scope are not necessarily
    --  contiguous (e.g. for packages) the first entry on the visibility chain
    --  for N is not necessarily in the current scope.