We failed to use the padded type for the renaming as in the non-private case.
Tested on i586-suse-linux, applied on the mainline. 2012-05-06 Eric Botcazou <ebotca...@adacore.com> * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: In the renaming case, use the padded type if the renamed object has an unconstrained type with default discriminant. 2012-05-06 Eric Botcazou <ebotca...@adacore.com> * gnat.dg/specs/renamings.ads: Rename to... * gnat.dg/specs/renaming1.ads: ...this. * gnat.dg/specs/renaming2.ads: New test. * gnat.dg/specs/renaming2_pkg1.ads: New helper. * gnat.dg/specs/renaming2_pkg2.ads: Likewise. * gnat.dg/specs/renaming2_pkg3.ads: Likewise. * gnat.dg/specs/renaming2_pkg4.ad[sb]: Likewise. -- Eric Botcazou
Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 187206) +++ gcc-interface/decl.c (working copy) @@ -938,6 +938,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit gnu_type = TREE_TYPE (gnu_expr); } + /* Or else, if the renamed object has an unconstrained type with + default discriminant, use the padded type. */ + else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr)) + && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr))) + == gnu_type + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) + gnu_type = TREE_TYPE (gnu_expr); + /* Case 1: If this is a constant renaming stemming from a function call, treat it as a normal object whose initial value is what is being renamed. RM 3.3 says that the result of evaluating a
-- { dg-do compile } with Renaming2_Pkg1; package Renaming2 is type T is null record; package Iter is new Renaming2_Pkg1.GP.Inner (T); end Renaming2;
-- { dg-excess-errors "no code generated" } with Renaming2_Pkg2; with Renaming2_Pkg3; with Renaming2_Pkg4; package Renaming2_Pkg1 is package Impl is new Renaming2_Pkg3 (Base_Index_T => Positive, Value_T => Renaming2_Pkg2.Root); use Impl; package GP is new Renaming2_Pkg4 (Length_T => Impl.Length_T, Value_T => Renaming2_Pkg2.Root); end Renaming2_Pkg1;
package Renaming2_Pkg2 is type Root is private; private type Root (D : Boolean := False) is record case D is when True => N : Natural; when False => null; end case; end record; end Renaming2_Pkg2;
-- { dg-excess-errors "no code generated" } generic type Base_Index_T is range <>; type Value_T is private; package Renaming2_Pkg3 is type T is private; subtype Length_T is Base_Index_T range 0 .. Base_Index_T'Last; function Value (L : Length_T) return Value_T; function Next return Length_T; private type Obj_T is null record; type T is access Obj_T; end Renaming2_Pkg3;
package body Renaming2_Pkg4 is package body Inner is function Next_Value return Value_T is Next_Value : Value_T renames Value (Next); begin return Next_Value; end Next_Value; end Inner; end Renaming2_Pkg4;
-- { dg-excess-errors "no code generated" } generic type Length_T is range <>; with function Next return Length_T is <>; type Value_T is private; with function Value (L : Length_T) return Value_T is <>; package Renaming2_Pkg4 is generic type T is private; package Inner is type Slave_T is tagged null record; function Next_Value return Value_T; end Inner; end Renaming2_Pkg4;