[Ada] Fix ICE on 'Old attribute and discriminated record type

[Eric Botcazou]

This is an internal error on a postcondition applying the 'Old attribute to a 
parameter with discriminated record type.  The problem is that S'Old ends up 
being rewritten into a local constrained variable very late in the game by the 
front-end and this yields a slightly skewed tree.

Fixed thusly, tested on x86_64-suse-linux, applied on the mainline.


2012-11-23  Eric Botcazou  <ebotca...@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  <ebotca...@adacore.com>

        * gnat.dg/discr40.ad[sb]: New test.


-- 
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 193720)
+++ gcc-interface/trans.c	(working copy)
@@ -1700,7 +1700,20 @@ Attribute_to_gnu (Node_Id gnat_node, tre
 	      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));
 

-- { 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;