[multiple changes]

2016-10-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Add new usage for Elist29 and Node35.
	(Anonymous_Designated_Type): New routine.
	(Anonymous_Master): Removed.
	(Anonymous_Masters): New routine.
	(Set_Anonymous_Designated_Type): New routine.
	(Set_Anonymous_Master): Removed.
	(Set_Anonymous_Masters): New routine.
	(Write_Field29_Name): Add output for Anonymous_Masters.
	(Write_Field35_Name): Remove the output for Anonymous_Master. Add
	output for Anonymous_Designated_Type.
	* einfo.ads Remove attribute Anonymous_Master along with
	usage in entities. Add attributes Anonymous_Designated_Type
	and Anonymous_Masters along with usage in entities.
	(Anonymous_Designated_Type): New routine along with pragma Inline.
	(Anonymous_Master): Removed along with pragma Inline.
	(Anonymous_Masters): New routine along with pragma Inline.
	(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
	(Set_Anonymous_Master): Removed along with pragma Inline.
	(Set_Anonymous_Masters): New routine along with pragma Inline.
	* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
	defined in the same unit if it services the same designated
	type, otherwise create a new one.
	(Create_Anonymous_Master): Reimplemented.
	(Current_Anonymous_Master): New routine.
	(In_Subtree): Removed.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
	Check properly whether there is an explicit assertion policy
	for predicate checking, even in the presence of a general Ignore
	assertion policy.

2016-10-12  Steve Baird  <baird@adacore.com>

	* sem.adb (Walk_Library_Items): Cope with ignored ghost units.

From-SVN: r241049

gcc/ada/ChangeLog

+2016-10-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb Add new usage for Elist29 and Node35.
+	(Anonymous_Designated_Type): New routine.
+	(Anonymous_Master): Removed.
+	(Anonymous_Masters): New routine.
+	(Set_Anonymous_Designated_Type): New routine.
+	(Set_Anonymous_Master): Removed.
+	(Set_Anonymous_Masters): New routine.
+	(Write_Field29_Name): Add output for Anonymous_Masters.
+	(Write_Field35_Name): Remove the output for Anonymous_Master. Add
+	output for Anonymous_Designated_Type.
+	* einfo.ads Remove attribute Anonymous_Master along with
+	usage in entities. Add attributes Anonymous_Designated_Type
+	and Anonymous_Masters along with usage in entities.
+	(Anonymous_Designated_Type): New routine along with pragma Inline.
+	(Anonymous_Master): Removed along with pragma Inline.
+	(Anonymous_Masters): New routine along with pragma Inline.
+	(Set_Anonymous_Designated_Type): New routine along with pragma Inline.
+	(Set_Anonymous_Master): Removed along with pragma Inline.
+	(Set_Anonymous_Masters): New routine along with pragma Inline.
+	* exp_ch7.adb (Build_Anonymous_Master): Reuse an anonymous master
+	defined in the same unit if it services the same designated
+	type, otherwise create a new one.
+	(Create_Anonymous_Master): Reimplemented.
+	(Current_Anonymous_Master): New routine.
+	(In_Subtree): Removed.
+
+2016-10-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, case Dynamic_Predicate):
+	Check properly whether there is an explicit assertion policy
+	for predicate checking, even in the presence of a general Ignore
+	assertion policy.
+
+2016-10-12  Steve Baird  <baird@adacore.com>
+
+	* sem.adb (Walk_Library_Items): Cope with ignored ghost units.
+
 2016-10-12  Ed Schonberg  <schonberg@adacore.com>
 
 	* lib-writ.adb (Write_ALI): Removal of unused file entries from

gcc/ada/einfo.adb

@@ -244,6 +244,7 @@ package body Einfo is
    --    Relative_Deadline_Variable      Node28
    --    Underlying_Record_View          Node28
 
+   --    Anonymous_Masters               Elist29
    --    BIP_Initialization_Call         Node29
    --    Subprograms_For_Type            Elist29
 
@@ -265,7 +266,7 @@ package body Einfo is
 
    --    Contract                        Node34
 
-   --    Anonymous_Master                Node35
+   --    Anonymous_Designated_Type       Node35
    --    Import_Pragma                   Node35
 
    --    Class_Wide_Preconds             List38
@@ -766,11 +767,20 @@ package body Einfo is
       return Uint14 (Id);
    end Alignment;
 
-   function Anonymous_Master (Id : E) return E is
+   function Anonymous_Designated_Type (Id : E) return E is
    begin
-      pragma Assert (Is_Type (Id));
+      pragma Assert (Ekind (Id) = E_Variable);
       return Node35 (Id);
-   end Anonymous_Master;
+   end Anonymous_Designated_Type;
+
+   function Anonymous_Masters (Id : E) return L is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function,
+                                   E_Package,
+                                   E_Procedure,
+                                   E_Subprogram_Body));
+      return Elist29 (Id);
+   end Anonymous_Masters;
 
    function Anonymous_Object (Id : E) return E is
    begin
@@ -3726,11 +3736,20 @@ package body Einfo is
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
-   procedure Set_Anonymous_Master (Id : E; V : E) is
+   procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
    begin
-      pragma Assert (Is_Type (Id));
+      pragma Assert (Ekind (Id) = E_Variable);
       Set_Node35 (Id, V);
-   end Set_Anonymous_Master;
+   end Set_Anonymous_Designated_Type;
+
+   procedure Set_Anonymous_Masters (Id : E; V : L) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function,
+                                   E_Package,
+                                   E_Procedure,
+                                   E_Subprogram_Body));
+      Set_Elist29 (Id, V);
+   end Set_Anonymous_Masters;
 
    procedure Set_Anonymous_Object (Id : E; V : E) is
    begin
@@ -10503,6 +10522,12 @@ package body Einfo is
    procedure Write_Field29_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Function                                   |
+              E_Package                                    |
+              E_Procedure                                  |
+              E_Subprogram_Body                            =>
+            Write_Str ("Anonymous_Masters");
+
          when E_Constant                                   |
               E_Variable                                   =>
             Write_Str ("BIP_Initialization_Call");
@@ -10650,8 +10675,8 @@ package body Einfo is
    procedure Write_Field35_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when Type_Kind                                    =>
-            Write_Str ("Anonymous_Master");
+         when E_Variable                                   =>
+            Write_Str ("Anonymous_Designated_Type");
 
          when Subprogram_Kind                              =>
             Write_Str ("Import_Pragma");

gcc/ada/einfo.ads

@@ -438,11 +438,15 @@ package Einfo is
 --       definition clause with an (obsolescent) mod clause is converted
 --       into an attribute definition clause for this purpose.
 
---    Anonymous_Master (Node35)
---       Defined in all types. Contains the entity of an anonymous finalization
---       master which services all anonymous access types associated with the
---       same designated type within the current semantic unit. The attribute
---       is set reactively during the expansion of allocators.
+--    Anonymous_Designated_Type (Node35)
+--       Defined in variables which represent anonymous finalization masters.
+--       Contains the designated type which is being services by the master.
+
+--    Anonymous_Masters (Elist29)
+--       Defined in packages, subprograms, and subprogram bodies. Contains a
+--       list of anonymous finalization masters declared within the related
+--       unit. The list acts as a mapping between a master and a designated
+--       type.
 
 --    Anonymous_Object (Node30)
 --       Present in protected and task type entities. Contains the entity of
@@ -5530,7 +5534,6 @@ package Einfo is
    --    Derived_Type_Link                   (Node31)
    --    No_Tagged_Streams_Pragma            (Node32)
    --    Linker_Section_Pragma               (Node33)
-   --    Anonymous_Master                    (Node35)
 
    --    Depends_On_Private                  (Flag14)
    --    Disable_Controlled                  (Flag253)
@@ -5982,6 +5985,7 @@ package Einfo is
    --    Overridden_Operation                (Node26)
    --    Wrapped_Entity                      (Node27)   (non-generic case only)
    --    Extra_Formals                       (Node28)
+   --    Anonymous_Masters                   (Elist29)  (non-generic case only)
    --    Corresponding_Equality              (Node30)   (implicit /= only)
    --    Thunk_Entity                        (Node31)   (thunk case only)
    --    Corresponding_Procedure             (Node32)   (generate C code only)
@@ -6207,6 +6211,7 @@ package Einfo is
    --    Package_Instantiation               (Node26)
    --    Current_Use_Clause                  (Node27)
    --    Finalizer                           (Node28)   (non-generic case only)
+   --    Anonymous_Masters                   (Elist29)  (non-generic case only)
    --    Contract                            (Node34)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
@@ -6292,6 +6297,7 @@ package Einfo is
    --    Overridden_Operation                (Node26)   (never for init proc)
    --    Wrapped_Entity                      (Node27)   (non-generic case only)
    --    Extra_Formals                       (Node28)
+   --    Anonymous_Masters                   (Elist29)  (non-generic case only)
    --    Static_Initialization               (Node30)   (init_proc only)
    --    Thunk_Entity                        (Node31)   (thunk case only)
    --    Corresponding_Function              (Node32)   (generate C code only)
@@ -6483,6 +6489,7 @@ package Einfo is
    --    Last_Entity                         (Node20)
    --    Scope_Depth_Value                   (Uint22)
    --    Extra_Formals                       (Node28)
+   --    Anonymous_Masters                   (Elist29)
    --    Contract                            (Node34)
    --    SPARK_Pragma                        (Node40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
@@ -6564,6 +6571,7 @@ package Einfo is
    --    Encapsulating_State                 (Node32)
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
+   --    Anonymous_Designated_Type           (Node35)
    --    SPARK_Pragma                        (Node40)
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
@@ -6837,7 +6845,8 @@ package Einfo is
    function Address_Taken                       (Id : E) return B;
    function Alias                               (Id : E) return E;
    function Alignment                           (Id : E) return U;
-   function Anonymous_Master                    (Id : E) return E;
+   function Anonymous_Designated_Type           (Id : E) return E;
+   function Anonymous_Masters                   (Id : E) return L;
    function Anonymous_Object                    (Id : E) return E;
    function Associated_Entity                   (Id : E) return E;
    function Associated_Formal_Package           (Id : E) return E;
@@ -7516,7 +7525,8 @@ package Einfo is
    procedure Set_Address_Taken                   (Id : E; V : B := True);
    procedure Set_Alias                           (Id : E; V : E);
    procedure Set_Alignment                       (Id : E; V : U);
-   procedure Set_Anonymous_Master                (Id : E; V : E);
+   procedure Set_Anonymous_Designated_Type       (Id : E; V : E);
+   procedure Set_Anonymous_Masters               (Id : E; V : L);
    procedure Set_Anonymous_Object                (Id : E; V : E);
    procedure Set_Associated_Entity               (Id : E; V : E);
    procedure Set_Associated_Formal_Package       (Id : E; V : E);
@@ -8314,7 +8324,8 @@ package Einfo is
    pragma Inline (Address_Taken);
    pragma Inline (Alias);
    pragma Inline (Alignment);
-   pragma Inline (Anonymous_Master);
+   pragma Inline (Anonymous_Designated_Type);
+   pragma Inline (Anonymous_Masters);
    pragma Inline (Anonymous_Object);
    pragma Inline (Associated_Entity);
    pragma Inline (Associated_Formal_Package);
@@ -8832,7 +8843,8 @@ package Einfo is
    pragma Inline (Set_Address_Taken);
    pragma Inline (Set_Alias);
    pragma Inline (Set_Alignment);
-   pragma Inline (Set_Anonymous_Master);
+   pragma Inline (Set_Anonymous_Designated_Type);
+   pragma Inline (Set_Anonymous_Masters);
    pragma Inline (Set_Anonymous_Object);
    pragma Inline (Set_Associated_Entity);
    pragma Inline (Set_Associated_Formal_Package);

gcc/ada/exp_ch7.adb

@@ -541,14 +541,16 @@ package body Exp_Ch7 is
         (Desig_Typ : Entity_Id;
          Unit_Id   : Entity_Id;
          Unit_Decl : Node_Id) return Entity_Id;
-      --  Create a new anonymous finalization master for access type Ptr_Typ
-      --  with designated type Desig_Typ. The declaration of the master along
-      --  with its specialized initialization is inserted in the declarative
-      --  part of unit Unit_Decl. Unit_Id denotes the entity of Unit_Decl.
+      --  Create a new anonymous master for access type Ptr_Typ with designated
+      --  type Desig_Typ. The declaration of the master and its initialization
+      --  are inserted in the declarative part of unit Unit_Decl. Unit_Id is
+      --  the entity of Unit_Decl.
 
-      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean;
-      --  Determine whether arbitrary node N appears within the subtree rooted
-      --  at node Root.
+      function Current_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id) return Entity_Id;
+      --  Find an anonymous master declared within unit Unit_Id which services
+      --  designated type Desig_Typ. If there is no such master, return Empty.
 
       -----------------------------
       -- Create_Anonymous_Master --
@@ -560,15 +562,41 @@ package body Exp_Ch7 is
          Unit_Decl : Node_Id) return Entity_Id
       is
          Loc : constant Source_Ptr := Sloc (Unit_Id);
-         Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Unit_Decl);
+
+         All_FMs   : Elist_Id;
          Decls     : List_Id;
          FM_Decl   : Node_Id;
          FM_Id     : Entity_Id;
          FM_Init   : Node_Id;
-         Pref      : Character;
          Unit_Spec : Node_Id;
 
       begin
+         --  Generate:
+         --    <FM_Id> : Finalization_Master;
+
+         FM_Id := Make_Temporary (Loc, 'A');
+
+         FM_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => FM_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+
+         --  Generate:
+         --    Set_Base_Pool
+         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
+
+         FM_Init :=
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
+             Parameter_Associations => New_List (
+               New_Occurrence_Of (FM_Id, Loc),
+               Make_Attribute_Reference (Loc,
+                 Prefix         =>
+                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
+                 Attribute_Name => Name_Unrestricted_Access)));
+
          --  Find the declarative list of the unit
 
          if Nkind (Unit_Decl) = N_Package_Declaration then
@@ -588,8 +616,8 @@ package body Exp_Ch7 is
 
          --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
 
-         --  There is no suitable place to create the anonymous master as the
-         --  subprogram is not in a declarative list.
+         --  There is no suitable place to create the master as the subprogram
+         --  is not in a declarative list.
 
          else
             Decls := Declarations (Unit_Decl);
@@ -600,100 +628,74 @@ package body Exp_Ch7 is
             end if;
          end if;
 
-         --  Step 1: Anonymous master creation
-
-         --  Use a unique prefix in case the same unit requires two anonymous
-         --  masters, one for the spec (S) and one for the body (B).
-
-         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
-            Pref := 'S';
-         else
-            Pref := 'B';
-         end if;
-
-         --  The name of the anonymous master has the following format:
-
-         --    [BS]scopN__scop1__chars_of_desig_typAM
-
-         --  The name utilizes the fully qualified name of the designated type
-         --  in case two controlled types with the same name are declared in
-         --  different scopes and both have anonymous access types.
-
-         FM_Id :=
-           Make_Defining_Identifier (Loc,
-             New_External_Name
-               (Related_Id => Get_Qualified_Name (Desig_Typ),
-                Suffix     => "AM",
-                Prefix     => Pref));
-
-         --  Associate the anonymous master with the designated type. This
-         --  ensures that any additional anonymous access types with the same
-         --  designated type will share the same anonymous master within the
-         --  same unit.
-
-         Set_Anonymous_Master (Desig_Typ, FM_Id);
+         Prepend_To (Decls, FM_Init);
+         Prepend_To (Decls, FM_Decl);
 
-         --  Generate:
-         --    <FM_Id> : Finalization_Master;
+         --  Use the scope of the unit when analyzing the declaration of the
+         --  master and its initialization actions.
 
-         FM_Decl :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => FM_Id,
-             Object_Definition   =>
-               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+         Push_Scope (Unit_Id);
+         Analyze (FM_Decl);
+         Analyze (FM_Init);
+         Pop_Scope;
 
-         --  Step 2: Initialization actions
+         --  Mark the master as servicing this specific designated type
 
-         --  Generate:
-         --    Set_Base_Pool
-         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
+         Set_Anonymous_Designated_Type (FM_Id, Desig_Typ);
 
-         FM_Init :=
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
-             Parameter_Associations => New_List (
-               New_Occurrence_Of (FM_Id, Loc),
-               Make_Attribute_Reference (Loc,
-                 Prefix         =>
-                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
-                 Attribute_Name => Name_Unrestricted_Access)));
+         --  Include the anonymous master in the list of existing masters which
+         --  appear in this unit. This effectively creates a mapping between a
+         --  master and a designated type which in turn allows for the reusal
+         --  of masters on a per-unit basis.
 
-         Prepend_To (Decls, FM_Init);
-         Prepend_To (Decls, FM_Decl);
+         All_FMs := Anonymous_Masters (Unit_Id);
 
-         --  Since the anonymous master and all its initialization actions are
-         --  inserted at top level, use the scope of the unit when analyzing.
+         if No (All_FMs) then
+            All_FMs := New_Elmt_List;
+            Set_Anonymous_Masters (Unit_Id, All_FMs);
+         end if;
 
-         Push_Scope (Spec_Id);
-         Analyze (FM_Decl);
-         Analyze (FM_Init);
-         Pop_Scope;
+         Prepend_Elmt (FM_Id, All_FMs);
 
          return FM_Id;
       end Create_Anonymous_Master;
 
-      ----------------
-      -- In_Subtree --
-      ----------------
+      ------------------------------
+      -- Current_Anonymous_Master --
+      ------------------------------
 
-      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean is
-         Par : Node_Id;
+      function Current_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id) return Entity_Id
+      is
+         All_FMs : constant Elist_Id := Anonymous_Masters (Unit_Id);
+         FM_Elmt : Elmt_Id;
+         FM_Id   : Entity_Id;
 
       begin
-         --  Traverse the parent chain until reaching the same root
+         --  Inspect the list of anonymous masters declared within the unit
+         --  looking for an existing master which services the same designated
+         --  type.
 
-         Par := N;
-         while Present (Par) loop
-            if Par = Root then
-               return True;
+         if Present (All_FMs) then
+            FM_Elmt := First_Elmt (All_FMs);
+            while Present (FM_Elmt) loop
+               FM_Id := Node (FM_Elmt);
+
+               --  The currect master services the same designated type. As a
+               --  result the master can be reused and associated with another
+               --  anonymous access-to-controlled type.
+
+               if Anonymous_Designated_Type (FM_Id) = Desig_Typ then
+                  return FM_Id;
                end if;
 
-            Par := Parent (Par);
+               Next_Elmt (FM_Elmt);
             end loop;
+         end if;
 
-         return False;
-      end In_Subtree;
+         return Empty;
+      end Current_Anonymous_Master;
 
       --  Local variables
 
@@ -714,7 +716,7 @@ package body Exp_Ch7 is
       end if;
 
       Unit_Decl := Unit (Cunit (Current_Sem_Unit));
-      Unit_Id   := Defining_Entity (Unit_Decl);
+      Unit_Id   := Unique_Defining_Entity (Unit_Decl);
 
       --  The compilation unit is a package instantiation. In this case the
       --  anonymous master is associated with the package spec as both the
@@ -738,21 +740,14 @@ package body Exp_Ch7 is
          Desig_Typ := Priv_View;
       end if;
 
-      FM_Id := Anonymous_Master (Desig_Typ);
+      --  Determine whether the current semantic unit already has an anonymous
+      --  master which services the designated type.
 
-      --  The designated type already has at least one anonymous access type
-      --  pointing to it within the current unit. Reuse the anonymous master
-      --  because the designated type is the same.
+      FM_Id := Current_Anonymous_Master (Desig_Typ, Unit_Id);
 
-      if Present (FM_Id)
-        and then In_Subtree (Declaration_Node (FM_Id), Root => Unit_Decl)
-      then
-         null;
+      --  If this is not the case, create a new master
 
-      --  Otherwise the designated type lacks an anonymous master or it is
-      --  declared in a different unit. Create a brand new master.
-
-      else
+      if No (FM_Id) then
          FM_Id := Create_Anonymous_Master (Desig_Typ, Unit_Id, Unit_Decl);
       end if;
 

gcc/ada/sem.adb

@@ -1767,6 +1767,11 @@ package body Sem is
                pragma Assert (False, "subunit");
                null;
 
+            when N_Null_Statement =>
+               pragma Assert (Is_Ignored_Ghost_Node (Original_Node (Item)));
+               --  Do not call Action for an ignored ghost unit
+               return;
+
             when others =>
                pragma Assert (False);
                null;
@@ -2095,6 +2100,11 @@ package body Sem is
                   --  happen when the body of a parent depends on some other
                   --  descendant.
 
+               when N_Null_Statement =>
+                  --  Ignore an ignored ghost unit
+                  pragma Assert (Is_Ignored_Ghost_Node (Original_Node (N)));
+                  null;
+
                when others =>
                   Par := Scope (Defining_Entity (Unit (CU)));
 

gcc/ada/sem_prag.adb

@@ -19136,15 +19136,17 @@ package body Sem_Prag is
             --  the rep item chain, for processing when the type is frozen.
             --  This is accomplished by a call to Rep_Item_Too_Late. We also
             --  mark the type as having predicates.
-            --  If the current policy is Ignore mark the subtype accordingly.
-            --  In the case of predicates we consider them enabled unless an
-            --  Ignore is specified, to preserve existing warnings.
+
+            --  If the current policy for predicate checking is Ignore mark the
+            --  subtype accordingly. In the case of predicates we consider them
+            --  enabled unless Ignore is specified (either directly or with a
+            --  general Assertion_Policy pragma) to preserve existing warnings.
 
             Set_Has_Predicates (Typ);
             Set_Predicates_Ignored (Typ,
               Present (Check_Policy_List)
                 and then
-                  Policy_In_Effect (Name_Assertion_Policy) = Name_Ignore);
+                  Policy_In_Effect (Name_Dynamic_Predicate) = Name_Ignore);
             Discard := Rep_Item_Too_Late (Typ, N, FOnly => True);
          end Predicate;