trans.c (Attribute_to_gnu): Look through a view conversion from constrained to uncons...

	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: 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 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
 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.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 52e525d..7194129 100644 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 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>

diff --git a/gcc/testsuite/gnat.dg/discr40.adb b/gcc/testsuite/gnat.dg/discr40.adb
new file mode 100644 (file)
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 (file)
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;