Commit 9b17f12b by Eric Botcazou Committed by Eric Botcazou

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
parent 29e100b3
2012-11-23 Eric Botcazou <ebotcazou@adacore.com> 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. * gcc-interface/decl.c (components_need_strict_alignment): New.
(components_to_record): Do not pack the variants if one of the fields (components_to_record): Do not pack the variants if one of the fields
needs strict alignment. Likewise for the variant part as a whole. needs strict alignment. Likewise for the variant part as a whole.
......
...@@ -1700,7 +1700,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -1700,7 +1700,20 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnat_param = Entity (Prefix (gnat_prefix)); 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; prefix_unused = true;
gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result_type = get_unpadded_type (Etype (gnat_node));
......
2012-11-23 Eric Botcazou <ebotcazou@adacore.com> 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. * gnat.dg/discr39.adb: New test.
2012-11-23 Georg-Johann Lay <avr@gjlay.de> 2012-11-23 Georg-Johann Lay <avr@gjlay.de>
......
-- { 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;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment