This patch adds code to detect a particular form of expansion produced by the
build-in-place machinery for the allocation of a private limited indefinite
type where the full view lacks discriminants. The allocator appears as a
qualified expression containing a build-in-place call. The patch prevents the
generation of spurious error messages related to missing initialization during
allocation.
------------
-- Source --
------------
-- types.ads
package Types is
type Simple_Rec is limited private;
type Fake_Indefinite_Rec (<>) is limited private;
type Indefinite_Rec (<>) is limited private;
function Make return Simple_Rec;
function Make return Fake_Indefinite_Rec;
function Make return Indefinite_Rec;
procedure Print_Data (Obj : Simple_Rec);
procedure Print_Data (Obj : Fake_Indefinite_Rec);
procedure Print_Data (Obj : Indefinite_Rec);
private
type Simple_Rec is limited record
Data : Integer;
end record;
type Fake_Indefinite_Rec is limited record
Data : Integer;
end record;
type Indefinite_Rec (Discr : Integer) is limited record
Data : Integer;
end record;
end Types;
-- types.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Types is
function Make return Simple_Rec is
begin
return Result : Simple_Rec := Simple_Rec'(Data => 1);
end Make;
function Make return Fake_Indefinite_Rec is
begin
return Result : Fake_Indefinite_Rec := Fake_Indefinite_Rec'(Data => 2);
end Make;
function Make return Indefinite_Rec is
begin
return Result : Indefinite_Rec := Indefinite_Rec'(Discr => 3, Data => 4);
end Make;
procedure Print_Data (Obj : Simple_Rec) is
begin
Put_Line (Obj.Data'Img);
end Print_Data;
procedure Print_Data (Obj : Fake_Indefinite_Rec) is
begin
Put_Line (Obj.Data'Img);
end Print_Data;
procedure Print_Data (Obj : Indefinite_Rec) is
begin
Put_Line (Obj.Data'Img);
end Print_Data;
end Types;
-- main.adb
with Types; use Types;
procedure Main is
type Simple_Rec_Ptr is access all Simple_Rec;
type Fake_Indefinite_Rec_Ptr is access all Fake_Indefinite_Rec;
type Indefinite_Rec_Ptr is access all Indefinite_Rec;
Obj1 : Simple_Rec_Ptr := new Simple_Rec'(Make);
Obj2 : Fake_Indefinite_Rec_Ptr := new Fake_Indefinite_Rec'(Make);
Obj3 : Indefinite_Rec_Ptr := new Indefinite_Rec'(Make);
begin
Print_Data (Obj1.all);
Print_Data (Obj2.all);
Print_Data (Obj3.all);
end Main;
-------------------------------------
-- Compilation and expected output --
-------------------------------------
$ gnatmake -q -gnat05 main.adb
$ ./main
$ 1
$ 2
$ 4
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-03-19 Hristian Kirtchev <kirtc...@adacore.com>
* sem_ch4.adb (Analyze_Allocator): Detect an allocator generated
by the build-in-place machinery where the designated type is
indefinite, but the underlying type is not. Do not emit errors
related to missing initialization in this case.
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 185520)
+++ sem_ch4.adb (working copy)
@@ -661,9 +661,22 @@
if Is_Indefinite_Subtype (Type_Id)
and then Serious_Errors_Detected = Sav_Errs
then
- if Is_Class_Wide_Type (Type_Id) then
+ -- The build-in-place machinery may produce an allocator when
+ -- the designated type is indefinite but the underlying type is
+ -- not. In this case the unknown discriminants are meaningless
+ -- and should not trigger error messages. Check the parent node
+ -- because the allocator is marked as coming from source.
+
+ if Present (Underlying_Type (Type_Id))
+ and then not Is_Indefinite_Subtype (Underlying_Type (Type_Id))
+ and then not Comes_From_Source (Parent (N))
+ then
+ null;
+
+ elsif Is_Class_Wide_Type (Type_Id) then
Error_Msg_N
("initialization required in class-wide allocation", N);
+
else
if Ada_Version < Ada_2005
and then Is_Limited_Type (Type_Id)
