From: Eric Botcazou Date: Fri, 23 Nov 2012 11:06:07 +0000 (+0000) Subject: trans.c (Attribute_to_gnu): Look through a view conversion from constrained to uncons... X-Git-Tag: upstream/12.2.0~72625 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9b17f12bdc0a1bdf922c02a2676cfcb95fb29d92;p=platform%2Fupstream%2Fgcc.git trans.c (Attribute_to_gnu): Look through a view conversion from constrained to unconstrained form. * gcc-interface/trans.c (Attribute_to_gnu) : Look through a view conversion from constrained to unconstrained form. From-SVN: r193751 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b835918..7e1c7bc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2012-11-23 Eric Botcazou + * gcc-interface/trans.c (Attribute_to_gnu) : Look through + a view conversion from constrained to unconstrained form. + +2012-11-23 Eric Botcazou + * gcc-interface/decl.c (components_need_strict_alignment): New. (components_to_record): Do not pack the variants if one of the fields needs strict alignment. Likewise for the variant part as a whole. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 52e525d..7194129 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1700,7 +1700,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) gnat_param = Entity (Prefix (gnat_prefix)); } - gnu_type = TREE_TYPE (gnu_prefix); + /* If the prefix is the view conversion of a constrained array to an + unconstrained form, we retrieve the constrained array because we + might not be able to substitute the PLACEHOLDER_EXPR coming from + the conversion. This can occur with the 'Old attribute applied + to a parameter with an unconstrained type, which gets rewritten + into a constrained local variable very late in the game. */ + if (TREE_CODE (gnu_prefix) == VIEW_CONVERT_EXPR + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (gnu_prefix))) + && !CONTAINS_PLACEHOLDER_P + (TYPE_SIZE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0))))) + gnu_type = TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)); + else + gnu_type = TREE_TYPE (gnu_prefix); + prefix_unused = true; gnu_result_type = get_unpadded_type (Etype (gnat_node)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7bc16ad..8021aef 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2012-11-23 Eric Botcazou + * gnat.dg/discr40.ad[sb]: New test. + +2012-11-23 Eric Botcazou + * gnat.dg/discr39.adb: New test. 2012-11-23 Georg-Johann Lay diff --git a/gcc/testsuite/gnat.dg/discr40.adb b/gcc/testsuite/gnat.dg/discr40.adb new file mode 100644 index 0000000..ea1b46a --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr40.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } +-- { dg-options "-gnat12 -gnata" } + +package body Discr40 is + + procedure Push (S: in out Stack; E : Element) is + begin + S.Length := S.Length + 1; + S.Data(S.Length) := E; + end Push; + +end Discr40; diff --git a/gcc/testsuite/gnat.dg/discr40.ads b/gcc/testsuite/gnat.dg/discr40.ads new file mode 100644 index 0000000..b4ec3ad --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr40.ads @@ -0,0 +1,26 @@ +pragma Assertion_Policy(Check); + +package Discr40 is + + subtype Element is Integer; + + type Vector is array (Positive range <>) of Element; + + type Stack (Max_Length : Natural) is + record + Length : Natural; + Data : Vector (1 .. Max_Length); + end record; + + function Not_Full (S : Stack) return Boolean is + (S.Length < S.Max_Length); + + procedure Push (S: in out Stack; E : Element) + with Pre => Not_Full(S), -- Precodition + Post => -- Postcondition + (S.Length = S'Old.Length + 1) and + (S.Data (S.Length) = E) and + (for all J in 1 .. S'Old.Length => + S.Data(J) = S'Old.Data(J)); + +end Discr40;