[Ada] An actual for a formal type that is an extesion of a limited interface

Message ID 20120222134753.GA2790@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Feb. 22, 2012, 1:47 p.m.
AI05-087 is a binding interpretation that applies to previous versions of the
language. The compiler diagnoses the error at the point of instantiation in
Ada2012 mode, and at a point of illegal use in  Ada2005 mode.

the command:
    gcc -c -gnat05 proc.adb
must yield:

   proc.adb:18:05: instantiation error at line 13
   proc.adb:18:05: assignment not available on limited type

the command:
   gcc -c -gnat12 proc.adb
must yield:

   proc.adb:18:45: actual for non-limited "T" cannot be a limited type
   proc.adb:18:45: instantiation abandoned
   proc.adb:33:06: "Store" is undefined

procedure Proc is
   package Pack is

      type Ifc is limited interface;

         type T is abstract new Ifc with private; -- T is nonlimited: 7.5(6.1/2)
         procedure Classwide_Store (Target : out T'Class; Source : T'Class);
   end Pack;
   package body Pack is
      procedure Classwide_Store (Target : out T'Class; Source : T'Class) is
          Target := Source;
      end Classwide_Store;
    end Pack;
    use Pack;

    procedure Store is new Classwide_Store (Ifc); -- legal? (No.)

     task type Tsk;
     task body Tsk is
     end Tsk;

     type Has_Task is limited new Ifc with
             F : Tsk;
         end record;

     X, Y : Has_Task;
     Store (X, Y);

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

2012-02-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Reject an
	assignment to a classwide type whose type is limited, as
	can happen in an instantiation in programs that run afoul or


Index: exp_ch5.adb
--- exp_ch5.adb	(revision 184470)
+++ exp_ch5.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -28,6 +28,7 @@ 
 with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
+with Errout;   use Errout;
 with Exp_Aggr; use Exp_Aggr;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
@@ -2086,6 +2087,18 @@ 
                          and then
                            not Restriction_Active (No_Dispatching_Calls))
+               if Is_Limited_Type (Typ) then
+                  --  This can happen in an instance when the formal is an
+                  --  extension of a limited interface, and the actual is
+                  --  limited. This is an error according to AI05-0087, but
+                  --  is not caught at the point of instantiation in earlier
+                  --  versions.
+                  Error_Msg_N ("assignment not available on limited type", N);
+                  return;
+               end if;
                --  Fetch the primitive op _assign and proper type to call it.
                --  Because of possible conflicts between private and full view,
                --  fetch the proper type directly from the operation profile.