This patch fixes a compiler crash on an allocator for an object of a limited
type, when the expression of the qualified expression is a type conversion.
Compiling bug1.adb must yield:
bug1.adb:29:08: illegal expression
for initialized allocator of a limited type (RM 7.5 (2.7/2))
---
pragma Ada_2012;
procedure Bug1 is
package Interf is
type T is limited interface;
subtype Implementor is T'Class;
function Init return T is abstract;
end Interf;
package Impl is
type T is limited new Interf.T with private;
overriding function Init return T;
private
type T is limited new Interf.T with null record;
end Impl;
package body Impl is
function Init return T is
begin
return Obj : T do
null;
end return;
end Init;
end Impl;
use Impl;
V : access Interf.T'Class;
Thing : T := Init;
begin
V := new Interf.T'class'(Interf.Implementor(Impl.Init));
end Bug1;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-05-02 Ed Schonberg <schonb...@adacore.com>
* sem_ch3.adb (OK_For_Limited_Init): A type conversion is not
always legal in the in-place initialization of a limited entity
(e.g. an allocator).
* sem_res.adb (Resolve_Allocator): Improve error message with RM
reference when allocator expression is illegal.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 235740)
+++ sem_ch3.adb (working copy)
@@ -18656,11 +18656,14 @@
is
begin
-- An object of a limited interface type can be initialized with any
- -- expression of a nonlimited descendant type.
+ -- expression of a nonlimited descendant type. However this does not
+ -- apply if this is a view conversion of some other expression. This
+ -- is checked below.
if Is_Class_Wide_Type (Typ)
and then Is_Limited_Interface (Typ)
and then not Is_Limited_Type (Etype (Exp))
+ and then Nkind (Exp) /= N_Type_Conversion
then
return True;
end if;
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 235714)
+++ sem_res.adb (working copy)
@@ -4767,13 +4767,21 @@
and then not In_Instance_Body
then
if not OK_For_Limited_Init (Etype (E), Expression (E)) then
- Error_Msg_N ("initialization not allowed for limited types", N);
+ if Nkind (Parent (N)) = N_Assignment_Statement then
+ Error_Msg_N
+ ("illegal expression for initialized allocator of a "
+ & "limited type (RM 7.5 (2.7/2))", N);
+ else
+ Error_Msg_N
+ ("initialization not allowed for limited types", N);
+ end if;
+
Explain_Limited_Type (Etype (E), N);
end if;
end if;
- -- A qualified expression requires an exact match of the type.
- -- Class-wide matching is not allowed.
+ -- A qualified expression requires an exact match of the type. Class-
+ -- wide matching is not allowed.
if (Is_Class_Wide_Type (Etype (Expression (E)))
or else Is_Class_Wide_Type (Etype (E)))
