This patch allows tagged incomplete types to be used in profiles of entries
and entry bodies, without the presence of a regular with_clause on the package
whose limited view provides those types.
The following must compile quietly:
gcc -c -gnat12 -gnatws tagged_half_1.adb
---
limited with Half_2;
package Half_1 is
type Unseen_Ref is access all Half_2.Unseen;
type Seen is record
Value : Unseen_Ref;
end record;
function foo (Val : Seen) return Half_2.Unseen;
function bar (Val : Half_2.Unseen) return Seen;
procedure Baz
(Val_1 : Half_2.Unseen;
Val_2 : in out Half_2.Unseen;
Val_3 : out Half_2.Unseen);
type Tagged_Unseen_Ref is access all Half_2.Tagged_Unseen;
type Tagged_Seen is tagged record
Value : Tagged_Unseen_Ref;
end record;
end Half_1;
---
with Half_1; use Half_1;
package Half_2 is
type Unseen is record
Value : Seen;
end record;
type Tagged_Unseen is tagged record
Value : Tagged_Seen;
end record;
end Half_2;
---
with Half_2;
package body Half_1 is
function foo (Val : Seen) return Half_2.Unseen is
begin
return Val.Value.all;
end;
function bar (Val : Half_2.Unseen) return Seen is
begin
return Val.Value;
end;
procedure Baz
(Val_1 : Half_2.Unseen;
Val_2 : in out Half_2.Unseen;
Val_3 : out Half_2.Unseen) is
begin
Val_3 := Val_2;
Val_2 := Val_1;
end;
end Half_1;
---
limited with Half_2;
package Tagged_Half_1 is
type Tagged_Unseen_Ref is access all Half_2.Tagged_Unseen;
type Tagged_Seen is tagged record
Value : Tagged_Unseen_Ref;
end record;
function bar (Val : Half_2.Tagged_Unseen) return Tagged_Seen;
procedure Baz
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen);
function Faux return Boolean;
end Tagged_Half_1;
---
package body Tagged_Half_1 is
-- Note that there's no "with Half_2;" here; we're still seeing the limited
-- view.
function Faux return Boolean is
begin
return False;
end Faux;
function bar (Val : Half_2.Tagged_Unseen) return Tagged_Seen is
begin
return Result : Tagged_Seen;
end;
procedure Baz
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen) is
begin
if Faux then
Baz (Val_1, Val_2, Val_3);
end if;
end;
task T is
entry E
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen);
end T;
task body T is
begin
select
accept E
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen);
or
terminate;
end select;
end T;
protected Prot is
entry E
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen);
end Prot;
protected body Prot is
entry E
(Val_1 : Half_2.Tagged_Unseen;
Val_2 : in out Half_2.Tagged_Unseen;
Val_3 : out Half_2.Tagged_Unseen) when True is
begin
Baz (Val_1, Val_2, Val_3);
end E;
end Prot;
end Tagged_Half_1;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-03 Ed Schonberg <[email protected]>
* exp_ch9.adb (Build_Renamed_Formal_Declaration): common procedure for
protected entries and task entries, to build the proper renaming
declaration for entry formals, used in debugging.
* exp_ch2.adb (Expand_Entry_Parameter): handle task and entry
parameters in the same way.
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 177190)
+++ exp_ch9.adb (working copy)
@@ -170,6 +170,19 @@
-- and Decl is the enclosing synchronized type declaration at whose
-- freeze point the generated body is analyzed.
+ function Build_Renamed_Formal_Declaration
+ (New_F : Entity_Id;
+ Formal : Entity_Id;
+ Comp : Entity_Id;
+ Renamed_Formal : Node_Id) return Node_Id;
+ -- Create a renaming declaration for a formal, within a protected entry
+ -- body or an accept body. The renamed object is a component of the
+ -- parameter block that is a parameter in the entry call.
+
+ -- In Ada2012, If the formal is an incomplete tagged type, the renaming
+ -- does not dereference the corresponding component to prevent an illegal
+ -- use of the incomplete type (AI05-0151).
+
procedure Build_Wrapper_Bodies
(Loc : Source_Ptr;
Typ : Entity_Id;
@@ -637,10 +650,11 @@
-- The name of the formal that holds the address of the parameter block
-- for the call.
- Comp : Entity_Id;
- Decl : Node_Id;
- Formal : Entity_Id;
- New_F : Entity_Id;
+ Comp : Entity_Id;
+ Decl : Node_Id;
+ Formal : Entity_Id;
+ New_F : Entity_Id;
+ Renamed_Formal : Node_Id;
begin
Formal := First_Formal (Ent);
@@ -667,18 +681,16 @@
Set_Actual_Subtype (New_F, Actual_Subtype (Formal));
+ Renamed_Formal :=
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Unchecked_Convert_To (Entry_Parameters_Type (Ent),
+ Make_Identifier (Loc, Chars (Ptr))),
+ Selector_Name => New_Reference_To (Comp, Loc));
+
Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => New_F,
- Subtype_Mark =>
- New_Reference_To (Etype (Formal), Loc),
- Name =>
- Make_Explicit_Dereference (Loc,
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (Entry_Parameters_Type (Ent),
- Make_Identifier (Loc, Chars (Ptr))),
- Selector_Name => New_Reference_To (Comp, Loc))));
+ Build_Renamed_Formal_Declaration
+ (New_F, Formal, Comp, Renamed_Formal);
Append (Decl, Decls);
Set_Renamed_Object (Formal, New_F);
@@ -1576,6 +1588,46 @@
return Rec_Nam;
end Build_Parameter_Block;
+ --------------------------------------
+ -- Build_Renamed_Formal_Declaration --
+ --------------------------------------
+
+ function Build_Renamed_Formal_Declaration
+ (New_F : Entity_Id;
+ Formal : Entity_Id;
+ Comp : Entity_Id;
+ Renamed_Formal : Node_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (New_F);
+ Decl : Node_Id;
+
+ begin
+ -- If the formal is a tagged incomplete type, it is already passed
+ -- by reference, so it is sufficient to rename the pointer component
+ -- that corresponds to the actual. Otherwise we need to dereference
+ -- the pointer component to obtain the actual.
+
+ if Is_Incomplete_Type (Etype (Formal))
+ and then Is_Tagged_Type (Etype (Formal))
+ then
+ Decl :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => New_F,
+ Subtype_Mark => New_Reference_To (Etype (Comp), Loc),
+ Name => Renamed_Formal);
+
+ else
+ Decl :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => New_F,
+ Subtype_Mark => New_Reference_To (Etype (Formal), Loc),
+ Name =>
+ Make_Explicit_Dereference (Loc, Renamed_Formal));
+ end if;
+
+ return Decl;
+ end Build_Renamed_Formal_Declaration;
+
-----------------------
-- Build_PPC_Wrapper --
-----------------------
@@ -4965,10 +5017,11 @@
and then Present (Handled_Statement_Sequence (N))
then
declare
- Comp : Entity_Id;
- Decl : Node_Id;
- Formal : Entity_Id;
- New_F : Entity_Id;
+ Comp : Entity_Id;
+ Decl : Node_Id;
+ Formal : Entity_Id;
+ New_F : Entity_Id;
+ Renamed_Formal : Node_Id;
begin
Push_Scope (Ent);
@@ -4997,21 +5050,18 @@
Set_Actual_Subtype (New_F, Actual_Subtype (Formal));
+ Renamed_Formal :=
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Unchecked_Convert_To (
+ Entry_Parameters_Type (Ent),
+ New_Reference_To (Ann, Loc)),
+ Selector_Name =>
+ New_Reference_To (Comp, Loc));
+
Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier =>
- New_F,
- Subtype_Mark =>
- New_Reference_To (Etype (Formal), Loc),
- Name =>
- Make_Explicit_Dereference (Loc,
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (
- Entry_Parameters_Type (Ent),
- New_Reference_To (Ann, Loc)),
- Selector_Name =>
- New_Reference_To (Comp, Loc))));
+ Build_Renamed_Formal_Declaration
+ (New_F, Formal, Comp, Renamed_Formal);
if No (Declarations (N)) then
Set_Declarations (N, New_List);
Index: exp_ch2.adb
===================================================================
--- exp_ch2.adb (revision 176998)
+++ exp_ch2.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, 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- --
@@ -520,9 +520,6 @@
then
Note_Possible_Modification (N, Sure => True);
end if;
-
- Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc));
- return;
end if;
-- What we need is a reference to the corresponding component of the
@@ -532,6 +529,9 @@
-- to turn this into a pointer to the parameter record and then we
-- select the required parameter field.
+ -- The same processing applies to protected entries, where the Accept_
+ -- Address is also the address of the Parameters record.
+
P_Comp_Ref :=
Make_Selected_Component (Loc,
Prefix =>
