[multiple changes]

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.

From-SVN: r177378

1 files changed, 102 insertions, 16 deletions

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 9a648e5..678948a 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -297,8 +297,11 @@ package body Exp_Ch7 is
 
    function Build_Cleanup_Statements (N : Node_Id) return List_Id;
    --  Create the clean up calls for an asynchronous call block, task master,
-   --  protected subprogram body, task allocation block or task body. If N is
-   --  neither of these constructs, the routine returns a new list.
+   --  protected subprogram body, task allocation block or task body. Generate
+   --  code to unregister the external tags of all library-level tagged types
+   --  found in the declarations and/or statements of N. If the context does
+   --  not contain the above constructs or types, the routine returns an empty
+   --  list.
 
    function Build_Exception_Handler
      (Loc         : Source_Ptr;
@@ -486,8 +489,11 @@ package body Exp_Ch7 is
       Is_Asynchronous_Call : constant Boolean :=
                                Nkind (N) = N_Block_Statement
                                  and then Is_Asynchronous_Call_Block (N);
+
       Is_Master            : constant Boolean :=
-                               Nkind (N) /= N_Entry_Body
+                               not Nkind_In (N, N_Entry_Body,
+                                                N_Package_Body,
+                                                N_Package_Declaration)
                                  and then Is_Task_Master (N);
       Is_Protected_Body    : constant Boolean :=
                                Nkind (N) = N_Subprogram_Body
@@ -501,6 +507,59 @@ package body Exp_Ch7 is
       Loc   : constant Source_Ptr := Sloc (N);
       Stmts : constant List_Id    := New_List;
 
+      procedure Unregister_Tagged_Types (Decls : List_Id);
+      --  Unregister the external tag of each tagged type found in the list
+      --  Decls. The generated statements are added to list Stmts.
+
+      -----------------------------
+      -- Unregister_Tagged_Types --
+      -----------------------------
+
+      procedure Unregister_Tagged_Types (Decls : List_Id) is
+         Decl   : Node_Id;
+         DT_Ptr : Entity_Id;
+         Typ    : Entity_Id;
+
+      begin
+         if No (Decls) or else Is_Empty_List (Decls) then
+            return;
+         end if;
+
+         --  Process all declarations or statements in reverse order
+
+         Decl := Last_Non_Pragma (Decls);
+         while Present (Decl) loop
+            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
+                  DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+
+                  --  Generate:
+                  --    Ada.Tags.Unregister_Tag (<Typ>P);
+
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (RTE (RE_Unregister_Tag), Loc),
+                      Parameter_Associations => New_List (
+                        New_Reference_To (DT_Ptr, Loc))));
+               end if;
+            end if;
+
+            Prev_Non_Pragma (Decl);
+         end loop;
+      end Unregister_Tagged_Types;
+
+   --  Start of processing for Build_Cleanup_Statements
+
    begin
       if Is_Task_Body then
          if Restricted_Profile then
@@ -711,6 +770,26 @@ package body Exp_Ch7 is
          end;
       end if;
 
+      --  Inspect all declaration and/or statement lists of N for library-level
+      --  tagged types. Generate code to unregister the external tag of such a
+      --  type.
+
+      if Nkind (N) = N_Package_Declaration then
+         Unregister_Tagged_Types (Private_Declarations (Specification (N)));
+         Unregister_Tagged_Types (Visible_Declarations (Specification (N)));
+
+      --  Accept statement, block, entry body, package body, protected body,
+      --  subprogram body or task body.
+
+      else
+         if Present (Handled_Statement_Sequence (N)) then
+            Unregister_Tagged_Types
+              (Statements (Handled_Statement_Sequence (N)));
+         end if;
+
+         Unregister_Tagged_Types (Declarations (N));
+      end if;
+
       return Stmts;
    end Build_Cleanup_Statements;
 
@@ -2686,22 +2765,29 @@ package body Exp_Ch7 is
          if For_Package_Spec then
             Process_Declarations
               (Priv_Decls, Preprocess => True, Top_Level => True);
+         end if;
 
-            --  The preprocessing has determined that the context has objects
-            --  that need finalization actions. Private declarations are
-            --  processed first in order to preserve possible dependencies
-            --  between public and private objects.
+         --  The current context may lack controlled objects, but require some
+         --  other form of completion (task termination for instance). In such
+         --  cases, the finalizer must be created and carry the additional
+         --  statements.
 
-            if Has_Ctrl_Objs then
-               Build_Components;
-               Process_Declarations (Priv_Decls);
-            end if;
+         if Acts_As_Clean or else Has_Ctrl_Objs then
+            Build_Components;
          end if;
 
-         --  Process the public declarations
+         --  The preprocessing has determined that the context has objects that
+         --  need finalization actions.
 
          if Has_Ctrl_Objs then
-            Build_Components;
+
+            --  Private declarations are processed first in order to preserve
+            --  possible dependencies between public and private objects.
+
+            if For_Package_Spec then
+               Process_Declarations (Priv_Decls);
+            end if;
+
             Process_Declarations (Decls);
          end if;
 
@@ -3495,7 +3581,7 @@ package body Exp_Ch7 is
                                  and then VM_Target = No_VM;
 
       Actions_Required     : constant Boolean :=
-                               Has_Controlled_Objects (N)
+                               Requires_Cleanup_Actions (N)
                                  or else Is_Asynchronous_Call
                                  or else Is_Master
                                  or else Is_Protected_Body
@@ -3770,7 +3856,7 @@ package body Exp_Ch7 is
       if Ekind (Spec_Ent) /= E_Generic_Package then
          Build_Finalizer
            (N           => N,
-            Clean_Stmts => No_List,
+            Clean_Stmts => Build_Cleanup_Statements (N),
             Mark_Id     => Empty,
             Top_Decls   => No_List,
             Defer_Abort => False,
@@ -3924,7 +4010,7 @@ package body Exp_Ch7 is
       if Ekind (Id) /= E_Generic_Package then
          Build_Finalizer
            (N           => N,
-            Clean_Stmts => No_List,
+            Clean_Stmts => Build_Cleanup_Statements (N),
             Mark_Id     => Empty,
             Top_Decls   => No_List,
             Defer_Abort => False,