[Ada] Default 'Input for array of limited object

[Arnaud Charlet]

This change fixes a bug in the generation of the default implementation
of the 'Input stream attribute in Ada 2005 mode for the case of an
unconstrained array of limited objects with a 'Read attribute. The following
compilation must be accepted quietly:

$ gcc -c -gnat05 unc_lim_input.adb

with Ada.Streams; use Ada.Streams;
package Limited_Remote is
   pragma Remote_Types;
   type T is tagged limited private;
   type A is array (Integer range <>) of T;
   procedure R (S : access Root_Stream_Type'Class; V : out A);
   for A'Read use R;
   procedure W (S : access Root_Stream_Type'Class; V : A);
   for A'Write use W;
private
   type T is tagged limited null record;
end Limited_Remote;
with Ada.Streams; use Ada.Streams;
with Limited_Remote;
procedure Unc_Lim_Input (S : access Root_Stream_Type'Class) is
   procedure Do_Stuff (X : Limited_Remote.A) is begin null; end;
begin
   Do_Stuff (Limited_Remote.A'Input (S));
end Unc_Lim_Input;

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

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* exp_strm.adb (Build_Array_Input_Function): In Ada 2005 mode, when
	returning a limited array, use an extended return statement.

-------------- next part --------------
Index: exp_strm.adb
===================================================================
--- exp_strm.adb	(revision 177026)
+++ exp_strm.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -149,7 +149,9 @@
       Decls  : List_Id;
       Ranges : List_Id;
       Stms   : List_Id;
+      Rstmt  : Node_Id;
       Indx   : Node_Id;
+      Odecl  : Node_Id;
 
    begin
       Decls := New_List;
@@ -197,13 +199,13 @@
       --  build a subtype indication with the proper bounds.
 
       if Is_Constrained (Stream_Base_Type (Typ)) then
-         Append_To (Decls,
+         Odecl :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
              Object_Definition =>
-               New_Occurrence_Of (Stream_Base_Type (Typ), Loc)));
+               New_Occurrence_Of (Stream_Base_Type (Typ), Loc));
       else
-         Append_To (Decls,
+         Odecl :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
              Object_Definition =>
@@ -212,20 +214,35 @@
                    New_Occurrence_Of (Stream_Base_Type (Typ), Loc),
                  Constraint =>
                    Make_Index_Or_Discriminant_Constraint (Loc,
-                     Constraints => Ranges))));
+                     Constraints => Ranges)));
       end if;
 
-      Stms := New_List (
-         Make_Attribute_Reference (Loc,
-           Prefix => New_Occurrence_Of (Typ, Loc),
-           Attribute_Name => Name_Read,
-           Expressions => New_List (
-             Make_Identifier (Loc, Name_S),
-             Make_Identifier (Loc, Name_V))),
+      Rstmt := Make_Attribute_Reference (Loc,
+                 Prefix         => New_Occurrence_Of (Typ, Loc),
+                 Attribute_Name => Name_Read,
+                 Expressions    => New_List (
+                   Make_Identifier (Loc, Name_S),
+                   Make_Identifier (Loc, Name_V)));
 
-         Make_Simple_Return_Statement (Loc,
-           Expression => Make_Identifier (Loc, Name_V)));
+      if Ada_Version >= Ada_2005 then
+         Stms := New_List (
+            Make_Extended_Return_Statement (Loc,
+              Return_Object_Declarations => New_List (Odecl),
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  New_List (Rstmt))));
+      else
+         --  pragma Assert (not Is_Limited_Type (Typ));
+         --  Returning a local object, shouldn't happen in the case of a
+         --  limited type, but currently occurs in DSA stubs in Ada 95 mode???
 
+         Stms := New_List (
+                   Odecl,
+                   Rstmt,
+                   Make_Simple_Return_Statement (Loc,
+                     Expression => Make_Identifier (Loc, Name_V)));
+      end if;
+
       Fnam :=
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Input));