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.



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

3 files changed, 68 insertions, 37 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 784ef67cb87..c40a2434af5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,43 @@
+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).
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;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 488b300ab69..a5d6f97b14f 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;