Commit b603e37b by Arnaud Charlet

[multiple changes]

2009-07-10  Ed Schonberg  <schonberg@adacore.com>

	* 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  <miranda@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Use the full-view when
	inheriting attributes from a private Parent_Base.

From-SVN: r149464
parent 426908f8
2009-07-10 Ed Schonberg <schonberg@adacore.com>
* 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 <celier@adacore.com>
* make.adb: Do not include object directories or library ALI
directories of library projects in the object path.
2009-07-10 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Find_Interface_Tag): Reorder processing of incoming
Typ argument to ensure proper management of access types.
2009-07-10 Ed Schonberg <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Use the full-view when
inheriting attributes from a private Parent_Base.
2009-07-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch11.adb (analyze_raise_xxx_error): Remove consecutive raise
statements with the same condition.
2009-07-10 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Raise_Accessibility_Error): New procedure
2009-07-09 Tom Tromey <tromey@redhat.com>
* raise-gcc.c: Include dwarf2h (unconditionally).
......
......@@ -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;
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment