===================================================================
@@ -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)
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 <kirtchev@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.