2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>

	* a-tags.ads, a-tags.adb (Unregister_Tag): New routine.
	Remove the external tag of a tagged type from the internal hash table.
	* exp_ch7.adb (Build_Cleanup_Statements): Update the comment on the
	expanded usage of the routine. Strenghten the check for Is_Master. Add
	processing for tagged types.
	(Build_Finalizer): Create all the necessary lists used in finalizer
	creation when the processed context is a package that may contain
	tagged types.
	(Expand_Cleanup_Actions): Rename the call to Has_Controlled_Objects to
	Requires_Cleanup_Actions.
	(Expand_N_Package_Body): Package bodies may need clean up code
	depending on whether they contain tagged types.
	(Expand_N_Package_Declaration): Package declarations may need clean up
	code depending on whether they contain tagged types.
	(Unregister_Tagged_Types): New routine. Search through a list of
	declarations or statements, looking for non-abstract Ada tagged types.
	For each such type, generate code to unregister the external tag.
	* exp_util.adb (Has_Controlled_Objects (Node_Id)): Renamed to
	Requires_Cleanup_Actions.
	(Requires_Cleanup_Actions (List_Id, Boolean)): New routine. Search
	through a list of declarations or statements looking for non-abstract
	Ada tagged types or controlled objects.
	* exp_util.ads (Has_Controlled_Objects (Node_Id)): Renamed to
	Requires_Cleanup_Actions.
	(Has_Controlled_Objects (List_Id, Boolean)): Removed.
	* rtsfind.ads: Add entry RE_Unregister_Tag to tables RE_Id and
	RE_Unit_Table.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* prj-env.adb (For_All_Source_Dirs.For_Project): Check if project Prj
	has Ada sources, not project Project, because if the root project
	Project has no sources of its own, all projects will be deemed without
	sources.

2011-08-04  Gary Dismukes  <dismukes@adacore.com>

	* bindgen.adb (Gen_Adainit_Ada): Move the generation of the declaration
	of the No_Param_Proc acc-to-subp type used for initialization of
	__gnat_finalize_library_objects so that it's declared at library level
	rather than nested inside of the adainit routine.

2011-08-04  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_DT): Generate code to check the external tag ONLY
	if the tagged type has a representation clause which specifies its
	external tag.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb (Has_Private_Ancestor): now a flag on types.
	Remove previous procedure with that name.
	* sem_ch3.adb (Build_Derived_Record_Type): set Has_Private_Ancestor
	when appropriate.
	* sem_aggr.adb (Resolve_Extension_Aggregate): if the ancestor part is a
	subtype mark, the ancestor cannot have unknown discriminants.
	(Resolve_Record_Aggregate): if the type has invisible components
	because of a private ancestor, the aggregate is illegal.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* switch-m.adb (Normalize_Compiler_Switches): Recognize and take into
	account switches -gnat2005, -gnat12 and -gnat2012.

2011-08-04  Bob Duff  <duff@adacore.com>

	* s-tasdeb.ads: Minor comment fix.

2011-08-04  Arnaud Charlet  <charlet@adacore.com>

	* gnatlink.adb (Gnatlink): Pass -gnat83/95/05/12 switch to gcc in
	CodePeer mode.
	* switch.ads, switch.adb (Is_Language_Switch): New function.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* switch-c.adb: Minor comment addition.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* vms_conv.adb (Process_Argument): Fail graciously when qualifier
	ending with '=' is followed by a space (missing file name).

2011-08-04  Pascal Obry  <obry@adacore.com>

	* g-regist.ads: Fix size of HKEY on x86_64-windows.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Associations): New routine
	Check_Overloaded_Formal_Subprogram to reject a formal package when
	there is a named association or a box initialisation for an overloaded
	formal subprogram of the corresponding generic.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* alfa.ads (ALFA_Xref_Record): add component for type of entity
	* get_alfa.adb, put_alfa.adb: Read and write new component of
	cross-reference.
	* lib-xref-alfa.adb (Collect_ALFA): generate new component.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177378 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 257 insertions, 232 deletions

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 83682e73652..83fed95a675 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -147,6 +147,17 @@ package body Exp_Util is
       N      : Node_Id) return Entity_Id;
    --  Create an implicit subtype of CW_Typ attached to node N
 
+   function Requires_Cleanup_Actions
+     (L           : List_Id;
+      For_Package : Boolean) return Boolean;
+   --  Given a list L, determine whether it contains one of the following:
+   --
+   --    1) controlled objects
+   --    2) library-level tagged types
+   --
+   --  Flag For_Package should be set when the list comes from a package spec
+   --  or body.
+
    ----------------------
    -- Adjust_Condition --
    ----------------------
@@ -2579,238 +2590,6 @@ package body Exp_Util is
       end if;
    end Has_Access_Constraint;
 
-   ----------------------------
-   -- Has_Controlled_Objects --
-   ----------------------------
-
-   function Has_Controlled_Objects (N : Node_Id) return Boolean is
-      For_Pkg : constant Boolean :=
-                  Nkind_In (N, N_Package_Body, N_Package_Specification);
-
-   begin
-      case Nkind (N) is
-         when N_Accept_Statement      |
-              N_Block_Statement       |
-              N_Entry_Body            |
-              N_Package_Body          |
-              N_Protected_Body        |
-              N_Subprogram_Body       |
-              N_Task_Body             =>
-            return Has_Controlled_Objects (Declarations (N), For_Pkg)
-                     or else
-
-                  --  An expanded sequence of statements may introduce
-                  --  controlled objects.
-
-                  (Present (Handled_Statement_Sequence (N))
-                     and then
-                   Has_Controlled_Objects
-                     (Statements (Handled_Statement_Sequence (N)), For_Pkg));
-
-         when N_Package_Specification =>
-            return Has_Controlled_Objects (Visible_Declarations (N), For_Pkg)
-                     or else
-                   Has_Controlled_Objects (Private_Declarations (N), For_Pkg);
-
-         when others                  =>
-            return False;
-      end case;
-   end Has_Controlled_Objects;
-
-   ----------------------------
-   -- Has_Controlled_Objects --
-   ----------------------------
-
-   function Has_Controlled_Objects
-     (L           : List_Id;
-      For_Package : Boolean) return Boolean
-   is
-      Decl    : Node_Id;
-      Expr    : Node_Id;
-      Obj_Id  : Entity_Id;
-      Obj_Typ : Entity_Id;
-      Pack_Id : Entity_Id;
-      Typ     : Entity_Id;
-
-   begin
-      if No (L)
-        or else Is_Empty_List (L)
-      then
-         return False;
-      end if;
-
-      Decl := First (L);
-      while Present (Decl) loop
-
-         --  Regular object declarations
-
-         if Nkind (Decl) = N_Object_Declaration then
-            Obj_Id  := Defining_Identifier (Decl);
-            Obj_Typ := Base_Type (Etype (Obj_Id));
-            Expr    := Expression (Decl);
-
-            --  Bypass any form of processing for objects which have their
-            --  finalization disabled. This applies only to objects at the
-            --  library level.
-
-            if For_Package
-              and then Finalize_Storage_Only (Obj_Typ)
-            then
-               null;
-
-            --  Transient variables are treated separately in order to minimize
-            --  the size of the generated code. See Exp_Ch7.Process_Transient_
-            --  Objects.
-
-            elsif Is_Processed_Transient (Obj_Id) then
-               null;
-
-            --  The object is of the form:
-            --    Obj : Typ [:= Expr];
-            --
-            --  Do not process the incomplete view of a deferred constant. Do
-            --  not consider tag-to-class-wide conversions.
-
-            elsif not Is_Imported (Obj_Id)
-              and then Needs_Finalization (Obj_Typ)
-              and then not (Ekind (Obj_Id) = E_Constant
-                              and then not Has_Completion (Obj_Id))
-              and then not Is_Tag_To_CW_Conversion (Obj_Id)
-            then
-               return True;
-
-            --  The object is of the form:
-            --    Obj : Access_Typ := Non_BIP_Function_Call'reference;
-            --
-            --    Obj : Access_Typ :=
-            --            BIP_Function_Call
-            --              (..., BIPaccess => null, ...)'reference;
-
-            elsif Is_Access_Type (Obj_Typ)
-              and then Needs_Finalization
-                         (Available_View (Designated_Type (Obj_Typ)))
-              and then Present (Expr)
-              and then
-                (Is_Null_Access_BIP_Func_Call (Expr)
-                   or else
-                (Is_Non_BIP_Func_Call (Expr)
-                   and then not Is_Related_To_Func_Return (Obj_Id)))
-            then
-               return True;
-
-            --  Processing for "hook" objects generated for controlled
-            --  transients declared inside an Expression_With_Actions.
-
-            elsif Is_Access_Type (Obj_Typ)
-              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
-              and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
-                         N_Object_Declaration
-              and then Is_Finalizable_Transient
-                         (Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
-            then
-               return True;
-
-            --  Simple protected objects which use type System.Tasking.
-            --  Protected_Objects.Protection to manage their locks should be
-            --  treated as controlled since they require manual cleanup.
-
-            elsif Ekind (Obj_Id) = E_Variable
-              and then
-                (Is_Simple_Protected_Type (Obj_Typ)
-                  or else Has_Simple_Protected_Object (Obj_Typ))
-            then
-               return True;
-            end if;
-
-         --  Specific cases of object renamings
-
-         elsif Nkind (Decl) = N_Object_Renaming_Declaration
-           and then Nkind (Name (Decl)) = N_Explicit_Dereference
-           and then Nkind (Prefix (Name (Decl))) = N_Identifier
-         then
-            Obj_Id  := Defining_Identifier (Decl);
-            Obj_Typ := Base_Type (Etype (Obj_Id));
-
-            --  Bypass any form of processing for objects which have their
-            --  finalization disabled. This applies only to objects at the
-            --  library level.
-
-            if For_Package
-              and then Finalize_Storage_Only (Obj_Typ)
-            then
-               null;
-
-            --  Return object of a build-in-place function. This case is
-            --  recognized and marked by the expansion of an extended return
-            --  statement (see Expand_N_Extended_Return_Statement).
-
-            elsif Needs_Finalization (Obj_Typ)
-              and then Is_Return_Object (Obj_Id)
-              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
-            then
-               return True;
-            end if;
-
-         --  Inspect the freeze node of an access-to-controlled type and
-         --  look for a delayed finalization collection. This case arises
-         --  when the freeze actions are inserted at a later time than the
-         --  expansion of the context. Since Build_Finalizer is never called
-         --  on a single construct twice, the collection will be ultimately
-         --  left out and never finalized. This is also needed for freeze
-         --  actions of designated types themselves, since in some cases the
-         --  finalization collection is associated with a designated type's
-         --  freeze node rather than that of the access type (see handling
-         --  for freeze actions in Build_Finalization_Collection).
-
-         elsif Nkind (Decl) = N_Freeze_Entity
-           and then Present (Actions (Decl))
-         then
-            Typ := Entity (Decl);
-
-            if (Is_Access_Type (Typ)
-                  and then not Is_Access_Subprogram_Type (Typ)
-                  and then Needs_Finalization
-                             (Available_View (Designated_Type (Typ))))
-              or else
-               (Is_Type (Typ)
-                  and then Needs_Finalization (Typ))
-            then
-               return True;
-            end if;
-
-         --  Nested package declarations
-
-         elsif Nkind (Decl) = N_Package_Declaration then
-            Pack_Id := Defining_Unit_Name (Specification (Decl));
-
-            if Nkind (Pack_Id) = N_Defining_Program_Unit_Name then
-               Pack_Id := Defining_Identifier (Pack_Id);
-            end if;
-
-            if Ekind (Pack_Id) /= E_Generic_Package
-              and then Has_Controlled_Objects (Specification (Decl))
-            then
-               return True;
-            end if;
-
-         --  Nested package bodies
-
-         elsif Nkind (Decl) = N_Package_Body then
-            Pack_Id := Corresponding_Spec (Decl);
-
-            if Ekind (Pack_Id) /= E_Generic_Package
-              and then Has_Controlled_Objects (Decl)
-            then
-               return True;
-            end if;
-         end if;
-
-         Next (Decl);
-      end loop;
-
-      return False;
-   end Has_Controlled_Objects;
-
    ----------------------------------
    -- Has_Following_Address_Clause --
    ----------------------------------
@@ -6346,6 +6125,252 @@ package body Exp_Util is
                    and then Is_Scalar_Type (Packed_Array_Type (UT)));
    end Represented_As_Scalar;
 
+   ------------------------------
+   -- Requires_Cleanup_Actions --
+   ------------------------------
+
+   function Requires_Cleanup_Actions (N : Node_Id) return Boolean is
+      For_Pkg : constant Boolean :=
+                  Nkind_In (N, N_Package_Body, N_Package_Specification);
+
+   begin
+      case Nkind (N) is
+         when N_Accept_Statement      |
+              N_Block_Statement       |
+              N_Entry_Body            |
+              N_Package_Body          |
+              N_Protected_Body        |
+              N_Subprogram_Body       |
+              N_Task_Body             =>
+            return
+              Requires_Cleanup_Actions (Declarations (N), For_Pkg)
+                or else
+              (Present (Handled_Statement_Sequence (N))
+                and then
+              Requires_Cleanup_Actions
+                (Statements (Handled_Statement_Sequence (N)), For_Pkg));
+
+         when N_Package_Specification =>
+            return
+              Requires_Cleanup_Actions (Visible_Declarations (N), For_Pkg)
+                or else
+              Requires_Cleanup_Actions (Private_Declarations (N), For_Pkg);
+
+         when others                  =>
+            return False;
+      end case;
+   end Requires_Cleanup_Actions;
+
+   ------------------------------
+   -- Requires_Cleanup_Actions --
+   ------------------------------
+
+   function Requires_Cleanup_Actions
+     (L           : List_Id;
+      For_Package : Boolean) return Boolean
+   is
+      Decl    : Node_Id;
+      Expr    : Node_Id;
+      Obj_Id  : Entity_Id;
+      Obj_Typ : Entity_Id;
+      Pack_Id : Entity_Id;
+      Typ     : Entity_Id;
+
+   begin
+      if No (L)
+        or else Is_Empty_List (L)
+      then
+         return False;
+      end if;
+
+      Decl := First (L);
+      while Present (Decl) loop
+
+         --  Library-level tagged types
+
+         if Nkind (Decl) = N_Full_Type_Declaration then
+            Typ := Defining_Identifier (Decl);
+
+            if Is_Tagged_Type (Typ)
+              and then Is_Library_Level_Entity (Typ)
+              and then Convention (Typ) = Convention_Ada
+              and then Present (Access_Disp_Table (Typ))
+              and then RTE_Available (RE_Unregister_Tag)
+              and then not No_Run_Time_Mode
+              and then not Is_Abstract_Type (Typ)
+            then
+               return True;
+            end if;
+
+         --  Regular object declarations
+
+         elsif Nkind (Decl) = N_Object_Declaration then
+            Obj_Id  := Defining_Identifier (Decl);
+            Obj_Typ := Base_Type (Etype (Obj_Id));
+            Expr    := Expression (Decl);
+
+            --  Bypass any form of processing for objects which have their
+            --  finalization disabled. This applies only to objects at the
+            --  library level.
+
+            if For_Package
+              and then Finalize_Storage_Only (Obj_Typ)
+            then
+               null;
+
+            --  Transient variables are treated separately in order to minimize
+            --  the size of the generated code. See Exp_Ch7.Process_Transient_
+            --  Objects.
+
+            elsif Is_Processed_Transient (Obj_Id) then
+               null;
+
+            --  The object is of the form:
+            --    Obj : Typ [:= Expr];
+            --
+            --  Do not process the incomplete view of a deferred constant. Do
+            --  not consider tag-to-class-wide conversions.
+
+            elsif not Is_Imported (Obj_Id)
+              and then Needs_Finalization (Obj_Typ)
+              and then not (Ekind (Obj_Id) = E_Constant
+                              and then not Has_Completion (Obj_Id))
+              and then not Is_Tag_To_CW_Conversion (Obj_Id)
+            then
+               return True;
+
+            --  The object is of the form:
+            --    Obj : Access_Typ := Non_BIP_Function_Call'reference;
+            --
+            --    Obj : Access_Typ :=
+            --            BIP_Function_Call
+            --              (..., BIPaccess => null, ...)'reference;
+
+            elsif Is_Access_Type (Obj_Typ)
+              and then Needs_Finalization
+                         (Available_View (Designated_Type (Obj_Typ)))
+              and then Present (Expr)
+              and then
+                (Is_Null_Access_BIP_Func_Call (Expr)
+                   or else
+                (Is_Non_BIP_Func_Call (Expr)
+                   and then not Is_Related_To_Func_Return (Obj_Id)))
+            then
+               return True;
+
+            --  Processing for "hook" objects generated for controlled
+            --  transients declared inside an Expression_With_Actions.
+
+            elsif Is_Access_Type (Obj_Typ)
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
+              and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                         N_Object_Declaration
+              and then Is_Finalizable_Transient
+                         (Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
+            then
+               return True;
+
+            --  Simple protected objects which use type System.Tasking.
+            --  Protected_Objects.Protection to manage their locks should be
+            --  treated as controlled since they require manual cleanup.
+
+            elsif Ekind (Obj_Id) = E_Variable
+              and then
+                (Is_Simple_Protected_Type (Obj_Typ)
+                  or else Has_Simple_Protected_Object (Obj_Typ))
+            then
+               return True;
+            end if;
+
+         --  Specific cases of object renamings
+
+         elsif Nkind (Decl) = N_Object_Renaming_Declaration
+           and then Nkind (Name (Decl)) = N_Explicit_Dereference
+           and then Nkind (Prefix (Name (Decl))) = N_Identifier
+         then
+            Obj_Id  := Defining_Identifier (Decl);
+            Obj_Typ := Base_Type (Etype (Obj_Id));
+
+            --  Bypass any form of processing for objects which have their
+            --  finalization disabled. This applies only to objects at the
+            --  library level.
+
+            if For_Package
+              and then Finalize_Storage_Only (Obj_Typ)
+            then
+               null;
+
+            --  Return object of a build-in-place function. This case is
+            --  recognized and marked by the expansion of an extended return
+            --  statement (see Expand_N_Extended_Return_Statement).
+
+            elsif Needs_Finalization (Obj_Typ)
+              and then Is_Return_Object (Obj_Id)
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
+            then
+               return True;
+            end if;
+
+         --  Inspect the freeze node of an access-to-controlled type and
+         --  look for a delayed finalization collection. This case arises
+         --  when the freeze actions are inserted at a later time than the
+         --  expansion of the context. Since Build_Finalizer is never called
+         --  on a single construct twice, the collection will be ultimately
+         --  left out and never finalized. This is also needed for freeze
+         --  actions of designated types themselves, since in some cases the
+         --  finalization collection is associated with a designated type's
+         --  freeze node rather than that of the access type (see handling
+         --  for freeze actions in Build_Finalization_Collection).
+
+         elsif Nkind (Decl) = N_Freeze_Entity
+           and then Present (Actions (Decl))
+         then
+            Typ := Entity (Decl);
+
+            if (Is_Access_Type (Typ)
+                  and then not Is_Access_Subprogram_Type (Typ)
+                  and then Needs_Finalization
+                             (Available_View (Designated_Type (Typ))))
+              or else
+               (Is_Type (Typ)
+                  and then Needs_Finalization (Typ))
+            then
+               return True;
+            end if;
+
+         --  Nested package declarations
+
+         elsif Nkind (Decl) = N_Package_Declaration then
+            Pack_Id := Defining_Unit_Name (Specification (Decl));
+
+            if Nkind (Pack_Id) = N_Defining_Program_Unit_Name then
+               Pack_Id := Defining_Identifier (Pack_Id);
+            end if;
+
+            if Ekind (Pack_Id) /= E_Generic_Package
+              and then Requires_Cleanup_Actions (Specification (Decl))
+            then
+               return True;
+            end if;
+
+         --  Nested package bodies
+
+         elsif Nkind (Decl) = N_Package_Body then
+            Pack_Id := Corresponding_Spec (Decl);
+
+            if Ekind (Pack_Id) /= E_Generic_Package
+              and then Requires_Cleanup_Actions (Decl)
+            then
+               return True;
+            end if;
+         end if;
+
+         Next (Decl);
+      end loop;
+
+      return False;
+   end Requires_Cleanup_Actions;
+
    ------------------------------------
    -- Safe_Unchecked_Type_Conversion --
    ------------------------------------