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 <qui...@adacore.com>
* exp_strm.adb (Build_Array_Input_Function): In Ada 2005 mode, when
returning a limited array, use an extended return statement.
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));
