gcc/testsuite/gnat.dg/raise_expr.adb


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

--  { dg-do compile }

procedure Raise_Expr is

   E : exception;

   type T is tagged limited null record;
   type TC is new T with null record;

   function F0 return Boolean is
   begin
       return raise E;
   end;

   function F return T'Class is
     TT : T;
   begin
      return raise E; -- Causes compile-time crash
   end F;

begin
   declare
      O : T'class  := F;
   begin
      null;
   end;
end Raise_Expr;