This is a regression present on the mainline and 4.7 branch. The compiler
aborts on the renaming of an object with a derived discriminated tagged type
converted to the parent type, if the parent type is itself derived from a root
discriminated tagged type and the renaming is later used as a prefix in the
selection of a component inherited from the root type.
Tested on i586-suse-linux, applied on mainline and 4.7 branch.
2012-07-03 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/utils2.c (build_simple_component_ref): Do not look
through an extension if the type contains a placeholder.
2012-07-03 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/discr37.ad[sb]: New test.
--
Eric Botcazou
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 189034)
+++ gcc-interface/utils2.c (working copy)
@@ -1912,10 +1912,12 @@ build_simple_component_ref (tree record_
break;
/* Next, see if we're looking for an inherited component in an extension.
- If so, look thru the extension directly. */
+ If so, look thru the extension directly, but not if the type contains
+ a placeholder, as it might be needed for a later substitution. */
if (!new_field
&& TREE_CODE (record_variable) == VIEW_CONVERT_EXPR
&& TYPE_ALIGN_OK (record_type)
+ && !type_contains_placeholder_p (record_type)
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (record_variable, 0)))
== RECORD_TYPE
&& TYPE_ALIGN_OK (TREE_TYPE (TREE_OPERAND (record_variable, 0))))
-- { dg-do compile }
package body Discr37 is
procedure Proc (A : access Child) is
B : Derived renames Derived (A.F(1).all);
C : Derived renames Derived (B.S(1).all);
begin
null;
end;
end Discr37;
package Discr37 is
subtype Index is Integer range 0 .. 100;
type Root;
type Frame_Ptr is access all Root'Class;
type Arr is array (Index range <>) of Frame_Ptr;
type Root (Level : Index) is tagged record
S : Arr (0 .. Level);
end record;
type Derived (Level : Index) is new Root (Level) with null record;
type Child is new Derived (0) with record
F : Arr (0 .. 100);
end record;
procedure Proc (A : access Child);
end Discr37;
