* [Ada] Allocation of unconstrained limited type
@ 2012-03-19 16:28 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2012-03-19 16:28 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 2999 bytes --]
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.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1284 bytes --]
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)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2012-03-19 16:28 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-03-19 16:28 [Ada] Allocation of unconstrained limited type Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).