From be1ba8de52bccf9585ac01aacb20d2c76991b205 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 10 Jul 2009 09:13:36 +0000 Subject: [PATCH] 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/ChangeLog | 40 ++++++++++++++++++++++++++++++++++++++++ gcc/ada/exp_ch7.adb | 36 ++++++++---------------------------- gcc/ada/sem_ch3.adb | 29 ++++++++++++++++++++--------- 3 files changed, 68 insertions(+), 37 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 784ef67..c40a243 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2009-07-10 Ed Schonberg + + * sem_prag.adb (Analyze pragma, case Task_Name): Analyze argument of + pragma, to capture global references if the context is generic. + + * exp_ch2.adb (Expand_Discriminant): If a task type discriminant + appears within the initialization procedure for the corresponding + record, replace it with the proper discriminal. + +2009-07-10 Vincent Celier + + * make.adb: Do not include object directories or library ALI + directories of library projects in the object path. + +2009-07-10 Javier Miranda + + * exp_util.adb (Find_Interface_Tag): Reorder processing of incoming + Typ argument to ensure proper management of access types. + +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. + +2009-07-10 Ed Schonberg + + * sem_ch11.adb (analyze_raise_xxx_error): Remove consecutive raise + statements with the same condition. + +2009-07-10 Robert Dewar + + * exp_ch4.adb (Raise_Accessibility_Error): New procedure + 2009-07-09 Tom Tromey * raise-gcc.c: Include dwarf2h (unconditionally). diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 03f0909..44da95f 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 488b300..a5d6f97 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6987,13 +6987,13 @@ package body Sem_Ch3 is -- Fields inherited from the Parent_Type Set_Discard_Names - (Derived_Type, Einfo.Discard_Names (Parent_Type)); + (Derived_Type, Einfo.Discard_Names (Parent_Type)); Set_Has_Specified_Layout - (Derived_Type, Has_Specified_Layout (Parent_Type)); + (Derived_Type, Has_Specified_Layout (Parent_Type)); Set_Is_Limited_Composite - (Derived_Type, Is_Limited_Composite (Parent_Type)); + (Derived_Type, Is_Limited_Composite (Parent_Type)); Set_Is_Private_Composite - (Derived_Type, Is_Private_Composite (Parent_Type)); + (Derived_Type, Is_Private_Composite (Parent_Type)); -- Fields inherited from the Parent_Base @@ -7014,10 +7014,22 @@ package body Sem_Ch3 is -- Fields inherited from the Parent_Base for record types if Is_Record_Type (Derived_Type) then - Set_OK_To_Reorder_Components - (Derived_Type, OK_To_Reorder_Components (Parent_Base)); - Set_Reverse_Bit_Order - (Derived_Type, Reverse_Bit_Order (Parent_Base)); + + -- Ekind (Parent_Base) is not necessarily E_Record_Type since + -- Parent_Base can be a private type or private extension. + + if Present (Full_View (Parent_Base)) then + Set_OK_To_Reorder_Components + (Derived_Type, + OK_To_Reorder_Components (Full_View (Parent_Base))); + Set_Reverse_Bit_Order + (Derived_Type, Reverse_Bit_Order (Full_View (Parent_Base))); + else + Set_OK_To_Reorder_Components + (Derived_Type, OK_To_Reorder_Components (Parent_Base)); + Set_Reverse_Bit_Order + (Derived_Type, Reverse_Bit_Order (Parent_Base)); + end if; end if; -- Direct controlled types do not inherit Finalize_Storage_Only flag @@ -7049,7 +7061,6 @@ package body Sem_Ch3 is else Set_Component_Alignment (Derived_Type, Component_Alignment (Parent_Base)); - Set_C_Pass_By_Copy (Derived_Type, C_Pass_By_Copy (Parent_Base)); end if; -- 2.7.4