From be1ba8de52bccf9585ac01aacb20d2c76991b205 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 10 Jul 2009 09:13:36 +0000 Subject: 2009-07-10 Ed Schonberg * exp_ch7.adb (Build_Final_List): If the list is being built for a Taft-Amendment type, place the finalization list in the package body, to ensure that the tree for the spec is identical whenever it is compiled. 2009-07-10 Javier Miranda * sem_ch3.adb (Build_Derived_Record_Type): Use the full-view when inheriting attributes from a private Parent_Base. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149464 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_ch7.adb | 36 ++++++++---------------------------- 1 file changed, 8 insertions(+), 28 deletions(-) (limited to 'gcc/ada/exp_ch7.adb') diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 03f0909e7cb..44da95fbf0c 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -442,39 +442,18 @@ package body Exp_Ch7 is New_Reference_To (RTE (RE_List_Controller), Loc)); + -- If the type is declared in a package declaration and designates a + -- Taft amendment type that requires finalization, place declaration + -- of finaliztion list in the body, because no client of the package + -- can create objects of the type and thus make use of this list. + if Has_Completion_In_Body (Directly_Designated_Type (Typ)) and then In_Package_Body (Current_Scope) and then Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body and then Nkind (Parent (Declaration_Node (Typ))) = N_Package_Specification then - -- The type is declared in a package declaration and designates a - -- Taft amendment type that requires finalization. In general we - -- assume that TA types are controlled, but we inhibit this - -- worst-case assumption for runtime files, for efficiency reasons - -- (see exp_ch3.adb). The reference to RE_List_Controller may have - -- added a with_clause to the current body. Formally the spec needs - -- the with_clause as well, so we add it now, for use by Codepeer. - -- We verify that we are within a package body, because this code - -- can also be invoked within a package instantiation. - - declare - Loc : constant Source_Ptr := Sloc (Typ); - Spec_Unit : constant Node_Id := - Library_Unit (Cunit (Current_Sem_Unit)); - List_Scope : constant Entity_Id := - Scope (RTE (RE_List_Controller)); - With_Clause : constant Node_Id := - Make_With_Clause (Loc, - Name => New_Occurrence_Of (List_Scope, Loc)); - begin - Set_Library_Unit - (With_Clause, Parent (Unit_Declaration_Node (List_Scope))); - Set_Corresponding_Spec (With_Clause, List_Scope); - Set_Implicit_With (With_Clause); - Append (With_Clause, Context_Items (Spec_Unit)); - end; - end if; + Insert_Action (Parent (Designated_Type (Typ)), Decl); -- The type may have been frozen already, and this is a late freezing -- action, in which case the declaration must be elaborated at once. @@ -482,11 +461,12 @@ package body Exp_Ch7 is -- because the freezing of the type does not build one. Otherwise, the -- declaration is one of the freezing actions for a user-defined type. - if Is_Frozen (Typ) + elsif Is_Frozen (Typ) or else (Nkind (N) = N_Allocator and then Ekind (Etype (N)) = E_Anonymous_Access_Type) then Insert_Action (N, Decl); + else Append_Freeze_Action (Typ, Decl); end if; -- cgit v1.2.1