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.
(components_to_record): Do not pack the variants if one of the fields
needs strict alignment. Likewise for the variant part as a whole.
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));
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.
2012-11-23 Georg-Johann Lay <avr@gjlay.de>
--- /dev/null
+-- { 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;
--- /dev/null
+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;