From 0ceb8ef3fca66e5cbd929f2d6c8a39c38995d7e1 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Tue, 3 Jul 2012 08:49:54 +0000 Subject: [PATCH] * gcc-interface/utils2.c (build_simple_component_ref): Do not look through an extension if the type contains a placeholder. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189202 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/utils2.c | 4 +++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/discr37.adb | 12 ++++++++++++ gcc/testsuite/gnat.dg/discr37.ads | 22 ++++++++++++++++++++++ 5 files changed, 46 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/discr37.adb create mode 100644 gcc/testsuite/gnat.dg/discr37.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0e0456c..f6eb89b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2012-07-03 Eric Botcazou + * 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 + * exp_disp.adb (Expand_Dispatching_Call): Propagate the convention on the designated subprogram type and also set Is_Dispatch_Table_Entity. (Expand_Interface_Thunk): Propagate the convention on the thunk. diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index c7dfe98..b72ebed 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1912,10 +1912,12 @@ build_simple_component_ref (tree record_variable, tree component, 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)))) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0dc8e25..539dfd3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2012-07-03 Eric Botcazou + + * gnat.dg/discr37.ad[sb]: New test. + 2012-07-03 Oleg Endo * g++.dg/other/packed1.C: Remove SH from xfail list. diff --git a/gcc/testsuite/gnat.dg/discr37.adb b/gcc/testsuite/gnat.dg/discr37.adb new file mode 100644 index 0000000..b0e750e --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr37.adb @@ -0,0 +1,12 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/discr37.ads b/gcc/testsuite/gnat.dg/discr37.ads new file mode 100644 index 0000000..7d91b2d --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr37.ads @@ -0,0 +1,22 @@ +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; -- 2.7.4