Patchwork [Ada] Implementation of AI05-0151: additional uses for incomplete types

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 11, 2010, 10:13 a.m.
Message ID <20101011101355.GA29986@adacore.com>
Download mbox | patch
Permalink /patch/67403/
State New
Headers show

Comments

Arnaud Charlet - Oct. 11, 2010, 10:13 a.m.
AI05-0151 extends the use of incomplete types, both as limited and non-limited
views. Tagged incomplete types can now appear in all profiles in declarations
and bodies. Incomplete untagged types can appear in all basic declarations.

This patch also fixes a visibility problem in the implementation of limited+
clauses, which allowed non-limited views to become improperly visible.

Compiling and executing proc.adb in Ada2012 mode must yield:

MT called with  15
Inner called with  111
MT called with  15
Inner called with  111
MT called with  15
Inner called with  111
---

with Q; with R;
procedure Proc is
   Obj_T : Q.Acc_T := R.Create (15);
begin
   Q.MT (Obj_T.all);
   Q.RMT (Obj_T.all);
   Q.Ptr (Obj_T.All);
end;
---
package P is
    type T is null record;     --  untagged

    type TT is tagged record   --  tagged
       Value : Integer;
    end record;
end P;
---
with Text_IO; use Text_IO;
with R; use R;
-- NOTE: no "with" of P here
package body Q is

   --  untagged : must be rejected in a body
   --  procedure M (X : P.T) is
   --     Y : Acc;
   --  begin
   --     Y := Create (15);
   --     Put_Line ("M called");
   --  end;  

   
   procedure MT(X : P.TT) is
      Y : Acc_T := Create (111);

      procedure Inner (Z : P.TT) is
      begin
      Put_Line ("Inner called with " & integer'image (Value (Z)));
      end Inner;

   begin
      Put_Line ("MT called with " & integer'image (Value (X)));
      Inner (Y.all);
   end;  
end Q;
---
limited with P;
package Q is
   --  Untagged records.

   type Acc is access P.T;
   type Acc_Sub is access procedure (X : P.T);
   type Acc_Ret is access function (X : Integer) return P.T;

   --  Ptr : Acc_Sub := M'Access;

   --  Tagged records.

   procedure MT (X : P.TT);
   type Acc_T is access P.TT;
   type Acc_SubT is access procedure (X : P.TT);
   type Acc_RetT is access function (X : Integer) return P.TT;
   procedure RMT (X : P.TT) renames MT;
   Ptr : Acc_SubT := MT'access;
end Q;
---
with P; use P;
package body  R is
  Obj : Acc := new T;
  Obj_T : Acc_T := new TT'(Value => 111);
  function Create (X : Integer) return Acc is
  begin
      return Obj;
  end;

  function Create (X : Integer) return Acc_T is
     It : Acc_T := new TT'(Value => X);
  begin
     return It;
  end;

  function Value (Obj : TT) return Integer is
  begin
      return Obj.Value;
  end;
end;
---
with P;
with Q; use Q;
package R is

  --  constructors for types declared in P.

  function Create (X : Integer) return Acc;
  function Create (X : Integer) return Acc_T;
  function Value (Obj : P.TT) return Integer;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): In Ada2012 an incomplete
	type is legal in the profile of any basic declaration.
	* sem_ch6.adb (Analyze_Return_Type, Process_Formals): In Ada2012 an
	incomplete type, including a limited view of a type, is legal in the
	profile of any subprogram declaration.
	If the type is tagged, its use is also legal in a body.
	* sem_ch10.adb (Install_Limited_With_Clause): Do not process context
	item if misplaced.
	(Install_Limited_Withed_Unit): Refine legality checks when both the
	limited and the non-limited view of a package are visible in the context
	of a unit.
	If this is not an error case, the limited view is ignored.
	freeze.adb (Freeze_Entity): In Ada2012, an incomplete type is legal in
	access to subprogram declarations

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 165293)
+++ sem_ch3.adb	(working copy)
@@ -1112,9 +1112,18 @@  package body Sem_Ch3 is
 
                else
                   if From_With_Type (Typ) then
-                     Error_Msg_NE
-                      ("illegal use of incomplete type&",
-                         Result_Definition (T_Def), Typ);
+
+                     --  AI05-151 : incomplete types are allowed in all basic
+                     --  declarations, including access to subprograms.
+
+                     if Ada_Version >= Ada_2012 then
+                        null;
+
+                     else
+                        Error_Msg_NE
+                         ("illegal use of incomplete type&",
+                            Result_Definition (T_Def), Typ);
+                     end if;
 
                   elsif Ekind (Current_Scope) = E_Package
                     and then In_Private_Part (Current_Scope)
@@ -7037,7 +7046,7 @@  package body Sem_Ch3 is
 
          Check_Or_Process_Discriminants (N, Derived_Type);
 
-         --  For non-tagged types the constraint on the Parent_Type must be
+         --  For untagged types, the constraint on the Parent_Type must be
          --  present and is used to rename the discriminants.
 
          if not Is_Tagged and then not Has_Discriminants (Parent_Type) then
@@ -13179,7 +13188,7 @@  package body Sem_Ch3 is
       end if;
 
       --  Final check: Direct descendants must have their primitives in the
-      --  same order. We exclude from this test non-tagged types and instances
+      --  same order. We exclude from this test untagged types and instances
       --  of formal derived types. We skip this test if we have already
       --  reported serious errors in the sources.
 
@@ -16180,9 +16189,9 @@  package body Sem_Ch3 is
                  ("discriminant defaults not allowed for formal type",
                   Expression (Discr));
 
-            --  Tagged types cannot have defaulted discriminants, but a
-            --  non-tagged private type with defaulted discriminants
-            --   can have a tagged completion.
+            --  Tagged types declarations cannot have defaulted discriminants,
+            --  but an untagged private type with defaulted discriminants can
+            --  have a tagged completion.
 
             elsif Is_Tagged_Type (Current_Scope)
               and then Comes_From_Source (N)
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 165287)
+++ sem_ch10.adb	(working copy)
@@ -3726,6 +3726,7 @@  package body Sem_Ch10 is
       while Present (Item) loop
          if Nkind (Item) = N_With_Clause
            and then Limited_Present (Item)
+           and then not Error_Posted (Item)
          then
             if Nkind (Name (Item)) = N_Selected_Component then
                Expand_Limited_With_Clause
@@ -4703,7 +4704,49 @@  package body Sem_Ch10 is
           (Is_Immediately_Visible (P)
             or else (Is_Child_Package and then Is_Visible_Child_Unit (P)))
       then
-         return;
+
+         --  The presence of both the limited and the analyzed nonlimited view
+         --  may also be an error, such as an illegal context for a limited
+         --  with_clause. In that case, do not process the context item at all.
+
+         if Error_Posted (N) then
+            return;
+         end if;
+
+         if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
+            declare
+               Item : Node_Id;
+            begin
+               Item := First (Context_Items (Cunit (Current_Sem_Unit)));
+               while Present (Item) loop
+                  if Nkind (Item) = N_With_Clause
+                    and then Comes_From_Source (Item)
+                    and then Entity (Name (Item)) = P
+                  then
+                     return;
+                  end if;
+
+                  Next (Item);
+               end loop;
+            end;
+
+            --  If this is a child body, assume that the nonlimited with_clause
+            --  appears in an ancestor. Could be refined ???
+
+            if Is_Child_Unit
+              (Defining_Entity
+                 (Unit (Library_Unit (Cunit (Current_Sem_Unit)))))
+            then
+               return;
+            end if;
+
+         else
+
+            --  If in package declaration, nonlimited view brought in from
+            --  parent unit or some error condition.
+
+            return;
+         end if;
       end if;
 
       if Debug_Flag_I then
Index: freeze.adb
===================================================================
--- freeze.adb	(revision 165283)
+++ freeze.adb	(working copy)
@@ -3738,7 +3738,11 @@  package body Freeze is
                then
                   if Is_Tagged_Type (Etype (Formal)) then
                      null;
-                  else
+
+                  --  AI05-151 : incomplete types are allowed in access to
+                  --  subprogram specifications.
+
+                  elsif Ada_Version < Ada_2012 then
                      Error_Msg_NE
                        ("invalid use of incomplete type&", E, Etype (Formal));
                   end if;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 165287)
+++ sem_ch6.adb	(working copy)
@@ -1432,8 +1432,27 @@  package body Sem_Ch6 is
                          and then
                            Ekind (Root_Type (Typ)) = E_Incomplete_Type)
             then
-               Error_Msg_NE
-                 ("invalid use of incomplete type&", Designator, Typ);
+               --  AI05-0151: Tagged incomplete types are allowed in all formal
+               --  parts. Untagged incomplete types are not allowed in bodies.
+
+               if Ada_Version >= Ada_2012 then
+                  if Is_Tagged_Type (Typ) then
+                     null;
+
+                  elsif Nkind_In (Parent (Parent (N)),
+                     N_Accept_Statement,
+                     N_Entry_Body,
+                     N_Subprogram_Body)
+                  then
+                     Error_Msg_NE
+                       ("invalid use of untagged incomplete type&",
+                          Designator, Typ);
+                  end if;
+
+               else
+                  Error_Msg_NE
+                    ("invalid use of incomplete type&", Designator, Typ);
+               end if;
             end if;
          end if;
 
@@ -8306,13 +8325,34 @@  package body Sem_Ch6 is
                elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
                                                N_Access_Procedure_Definition)
                then
-                  Error_Msg_NE
-                    ("invalid use of incomplete type&",
-                       Param_Spec, Formal_Type);
 
-                  --  Further checks on the legality of incomplete types
-                  --  in formal parts must be delayed until the freeze point
-                  --  of the enclosing subprogram or access to subprogram.
+                  --  AI05-0151: Tagged incomplete types are allowed in all
+                  --  formal parts. Untagged incomplete types are not allowed
+                  --  in bodies.
+
+                  if Ada_Version >= Ada_2012 then
+                     if Is_Tagged_Type (Formal_Type) then
+                        null;
+
+                     elsif Nkind_In (Parent (Parent (T)),
+                        N_Accept_Statement,
+                        N_Entry_Body,
+                        N_Subprogram_Body)
+                     then
+                        Error_Msg_NE
+                          ("invalid use of untagged incomplete type&",
+                             Ptype, Formal_Type);
+                     end if;
+
+                  else
+                     Error_Msg_NE
+                       ("invalid use of incomplete type&",
+                          Param_Spec, Formal_Type);
+
+                     --  Further checks on the legality of incomplete types
+                     --  in formal parts are delayed until the freeze point
+                     --  of the enclosing subprogram or access to subprogram.
+                  end if;
                end if;
 
             elsif Ekind (Formal_Type) = E_Void then