trans.c (Attribute_to_gnu): Look through a view conversion from constrained to unconstrained form.
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Look through a view conversion from constrained to unconstrained form. From-SVN: r193751
This commit is contained in:
parent
29e100b31a
commit
9b17f12bdc
|
@ -1,3 +1,8 @@
|
|||
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Look through
|
||||
a view conversion from constrained to unconstrained form.
|
||||
|
||||
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (components_need_strict_alignment): New.
|
||||
|
|
|
@ -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));
|
||||
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/discr40.ad[sb]: New test.
|
||||
|
||||
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/discr39.adb: New test.
|
||||
|
|
|
@ -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;
|
|
@ -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;
|
Loading…
Reference in New Issue