[Ada] Fix bug in front-end layout

[Arnaud Charlet]

Tested on i686-linux, committed on mainline.

This was a set of problems with generation of size functions by the front
end's type layout algorithms (currently only used by the non-GCC-based
GNAAMP compiler). The initial symptom was an assertion failure in
Install_Visible_Decls, which was being passed a private type. The idiom
causing this was a private type whose full type contained a discriminant-
dependent array component). The fix for that specific blowup was to check
Underlying_Type of an array's parent scope when determining the insertion
type in Layout_Array_Type. The assertion failure turned out to be masking
a more fundamental problem, namely that the V formals in various size
functions generated for a discriminated private type were being given
inconsistent type views (private vs. full entity). That resulted in
type mismatches when analyzing certain size functions, depending on
when the type was frozen.
The following test should compile silently with -gnatdF -gnatws -gnatc:
--
procedure FE_Layout_Bugs is
   subtype Subint is Integer range 0 .. 100;
   package Pkg is
      type Rec (D : Subint := 10) is private;
   private
      type Rec (D : Subint := 10) is record
         S : String (1 .. D);
      end record;
   end Pkg;
   R1 : Pkg.Rec;      -- Assert_Failure with GNAAMP (or with FE layout on)
   R2 : Pkg.Rec (10); -- Causes type mismatch errors after fix for A_F
   R3 : Pkg.Rec (7);
   package body Pkg is
      P1 : Pkg.Rec (10);
      P2 : Pkg.Rec;
   end Pkg;
begin
   null;
end FE_Layout_Bugs;

2005-06-14  Gary Dismukes  <dismukes@adacore.com>

	* layout.adb (Discrimify): Remove resetting of Vtype to the underlying
	type which turns out to be an incomplete and incorrect fix.
	(Layout_Array_Type): Use Underlying_Type when checking whether the scope
	of the type is declared in a record (for determination of insertion
	type).
	(SO_Ref_From_Expr): Test whether Vtype denotes a partial or full view of
	a private type and ensure that the primary entity is used for the type
	of the newly created function's V formal by taking the Etype of the
	view.

-------------- next part --------------
Index: layout.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/layout.adb,v
retrieving revision 1.14
diff -u -p -r1.14 layout.adb
--- layout.adb	6 Jul 2004 13:57:30 -0000	1.14
+++ layout.adb	15 Jun 2005 15:47:12 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -993,12 +993,6 @@ package body Layout is
                Decl := Parent (Parent (Entity (N)));
                Size := (Discrim, Size.Nod);
                Vtyp := Defining_Identifier (Decl);
-
-               --  Ensure that we get a private type's full type
-
-               if Present (Underlying_Type (Vtyp)) then
-                  Vtyp := Underlying_Type (Vtyp);
-               end if;
             end if;
 
             Typ := Etype (N);
@@ -1029,8 +1023,8 @@ package body Layout is
 
       --  Calculate proper type for insertions
 
-      if Is_Record_Type (Scope (E)) then
-         Insert_Typ := Scope (E);
+      if Is_Record_Type (Underlying_Type (Scope (E))) then
+         Insert_Typ := Underlying_Type (Scope (E));
       else
          Insert_Typ := E;
       end if;
@@ -2951,6 +2945,8 @@ package body Layout is
 
       Decl : Node_Id;
 
+      Vtype_Primary_View : Entity_Id;
+
       function Check_Node_V_Ref (N : Node_Id) return Traverse_Result;
       --  Function used to check one node for reference to V
 
@@ -2992,6 +2988,21 @@ package body Layout is
       if Has_V_Ref (Expr) = Abandon then
 
          pragma Assert (Present (Vtype));
+
+         --  Check whether Vtype is a view of a private type and ensure that
+         --  we use the primary view of the type (which is denoted by its
+         --  Etype, whether it's the type's partial or full view entity).
+         --  This is needed to make sure that we use the same (primary) view
+         --  of the type for all V formals, whether the current view of the
+         --  type is the partial or full view, so that types will always
+         --  match on calls from one size function to another.
+
+         if  Has_Private_Declaration (Vtype) then
+            Vtype_Primary_View := Etype (Vtype);
+         else
+            Vtype_Primary_View := Vtype;
+         end if;
+
          Set_Is_Discrim_SO_Function (K);
 
          Decl :=
@@ -3005,7 +3016,7 @@ package body Layout is
                        Defining_Identifier =>
                          Make_Defining_Identifier (Loc, Chars => Vname),
                        Parameter_Type      =>
-                         New_Occurrence_Of (Vtype, Loc))),
+                         New_Occurrence_Of (Vtype_Primary_View, Loc))),
                    Subtype_Mark =>
                      New_Occurrence_Of (Standard_Unsigned, Loc)),