2009-07-13 Emmanuel Briot <briot@adacore.com>

	* prj-err.adb (Error_Msg): One more case where a message should be
	considered as a warning.

	* gnatcmd.adb (GNATCmd): Fix previous change, which negated a test.

2009-07-13  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Expand_All_Calls_Remote_Subprogram_Call): Analyze
	calling stubs in the (library level) scope of the RCI locator, where it
	is attached, not in the caller's scope.

2009-07-13  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): In case of class-wide
	interface object declarations we delay the generation of the equivalent
	record type declarations until its expansion because there are cases in
	which they are not required.            

	* sem_util.adb (Implements_Interface): Add missing support for subtypes.

	* sem_disp.adb (Check_Controlling_Formals): Minor code cleanup plus
	addition of assertion.

	* exp_util.adb (Expand_Subtype_From_Expr): Renamings of class-wide
	interface types require no equivalent constrained type declarations
	because the expanded code only references the tag component associated
	with the interface.
	(Find_Interface_Tag): Improve management of interfaces that are
	ancestors of tagged types.

	* exp_ch3.adb (Expand_N_Object_Declaration): Improve the expansion of
	class-wide object declarations to add missing support to statically
	displace the pointer to the object to reference the tag component
	associated with the interface.

	* exp_disp.adb (Make_Tags) Avoid generation of internally generated
	auxiliary types associated with user-defined dispatching calls if the
	type has no user-defined primitives.



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

1 files changed, 31 insertions, 35 deletions

diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index f13c8a45eef..d975657f4a1 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -2755,11 +2755,11 @@ package body Exp_Dist is
    ---------------------------------------------
 
    procedure Expand_All_Calls_Remote_Subprogram_Call (N : Node_Id) is
+      Loc               : constant Source_Ptr := Sloc (N);
       Called_Subprogram : constant Entity_Id  := Entity (Name (N));
       RCI_Package       : constant Entity_Id  := Scope (Called_Subprogram);
-      Loc               : constant Source_Ptr := Sloc (N);
-      RCI_Locator       : Node_Id;
-      RCI_Cache         : Entity_Id;
+      RCI_Locator_Decl  : Node_Id;
+      RCI_Locator       : Entity_Id;
       Calling_Stubs     : Node_Id;
       E_Calling_Stubs   : Entity_Id;
 
@@ -2767,41 +2767,35 @@ package body Exp_Dist is
       E_Calling_Stubs := RCI_Calling_Stubs_Table.Get (Called_Subprogram);
 
       if E_Calling_Stubs = Empty then
-         RCI_Cache := RCI_Locator_Table.Get (RCI_Package);
-
-         if RCI_Cache = Empty then
-            RCI_Locator :=
-              RCI_Package_Locator
-                (Loc, Specification (Unit_Declaration_Node (RCI_Package)));
-            Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator);
-
-            --  The RCI_Locator package is inserted at the top level in the
-            --  current unit, and must appear in the proper scope, so that it
-            --  is not prematurely removed by the GCC back-end.
+         RCI_Locator := RCI_Locator_Table.Get (RCI_Package);
 
-            declare
-               Scop : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
-
-            begin
-               if Ekind (Scop) = E_Package_Body then
-                  Push_Scope (Spec_Entity (Scop));
+         --  The RCI_Locator package and calling stub are is inserted at the
+         --  top level in the current unit, and must appear in the proper scope
+         --  so that it is not prematurely removed by the GCC back end.
 
-               elsif Ekind (Scop) = E_Subprogram_Body then
-                  Push_Scope
-                     (Corresponding_Spec (Unit_Declaration_Node (Scop)));
-
-               else
-                  Push_Scope (Scop);
-               end if;
-
-               Analyze (RCI_Locator);
-               Pop_Scope;
-            end;
+         declare
+            Scop : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
+         begin
+            if Ekind (Scop) = E_Package_Body then
+               Push_Scope (Spec_Entity (Scop));
+            elsif Ekind (Scop) = E_Subprogram_Body then
+               Push_Scope
+                 (Corresponding_Spec (Unit_Declaration_Node (Scop)));
+            else
+               Push_Scope (Scop);
+            end if;
+         end;
 
-            RCI_Cache   := Defining_Unit_Name (RCI_Locator);
+         if RCI_Locator = Empty then
+            RCI_Locator_Decl :=
+              RCI_Package_Locator
+                (Loc, Specification (Unit_Declaration_Node (RCI_Package)));
+            Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator_Decl);
+            Analyze (RCI_Locator_Decl);
+            RCI_Locator := Defining_Unit_Name (RCI_Locator_Decl);
 
          else
-            RCI_Locator := Parent (RCI_Cache);
+            RCI_Locator_Decl := Parent (RCI_Locator);
          end if;
 
          Calling_Stubs := Build_Subprogram_Calling_Stubs
@@ -2811,10 +2805,12 @@ package body Exp_Dist is
             Asynchronous           => Nkind (N) = N_Procedure_Call_Statement
                                         and then
                                       Is_Asynchronous (Called_Subprogram),
-            Locator                => RCI_Cache,
+            Locator                => RCI_Locator,
             New_Name               => New_Internal_Name ('S'));
-         Insert_After (RCI_Locator, Calling_Stubs);
+         Insert_After (RCI_Locator_Decl, Calling_Stubs);
          Analyze (Calling_Stubs);
+         Pop_Scope;
+
          E_Calling_Stubs := Defining_Unit_Name (Specification (Calling_Stubs));
       end if;