[Ada] Double evaluation in allocator for unconstrained packed array

[Arnaud Charlet]

This patch fixes a typo in the expansion of an allocator for an unconstrained
packed array, when the expression is a function call.

The execution of tester below must yield:

in next_frame
in next_frame
 1
 2
---
with Media;
with ada.text_IO; 
procedure Tester is 
   Case_1 :        Media.Image :=     Media.Image' (Media.next_Frame); 
   Case_2 : access Media.Image := new Media.Image' (Media.next_Frame); 
begin 
   ada.text_io.put_line (Case_1 (5).Val'Img); 
   ada.text_io.put_line (Case_2 (5).Val'Img); 
end; 
---
with Ada.Text_IO; use Ada.Text_IO; 
package body Media 
is 
   Counter: Integer := 0; 
   function next_Frame return Image is 
   begin 
      put_line("in next_frame"); 
      counter := counter + 1; 
      return (1..10 => (val => counter)); 
   end next_Frame; 
end Media; 
---
package Media is 
   type Color is 
      record 
         Val : Integer; 
      end record; 

   type Image is array (Integer range <>) of Color; 
   pragma pack (Image);                                -- matters! 

   function next_Frame return Image; 
end Media; 

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Use consistent name for
	inner expression, to prevent double evaluation.

-------------- next part --------------
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 178205)
+++ exp_ch4.adb	(working copy)
@@ -1165,7 +1165,8 @@
                Insert_Action (Exp,
                  Make_Subtype_Declaration (Loc,
                    Defining_Identifier => ConstrT,
-                   Subtype_Indication  => Make_Subtype_From_Expr (Exp, T)));
+                   Subtype_Indication  =>
+                     Make_Subtype_From_Expr (Internal_Exp, T)));
                Freeze_Itype (ConstrT, Exp);
                Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
             end;