===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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))
then
+ 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.
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; generic 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 begin 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 begin null; end Tsk; type Has_Task is limited new Ifc with record F : Tsk; end record; X, Y : Has_Task; begin Store (X, Y); end; 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 AI05-0087.