Patchwork [Ada] Ada2012 : incomplete types can be used in more contexts

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 3, 2011, 7:38 a.m.
Message ID <20110803073835.GA6633@adacore.com>
Download mbox | patch
Permalink /patch/108028/
State New
Headers show

Comments

Arnaud Charlet - Aug. 3, 2011, 7:38 a.m.
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  <schonberg@adacore.com>

	* 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.

Patch

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 =>