gcc/testsuite/gnat.dg/abstract_with_anonymous_result.adb

   1 -- { dg-do run }
   2
   3 procedure Abstract_With_Anonymous_Result is
   4
   5    package Pkg is
   6       type I is abstract tagged null record;
   7       type Acc_I_Class is access all I'Class;
   8       function Func (V : I) return access I'Class is abstract;
   9       procedure Proc (V : access I'Class);
  10       type New_I is new I with null record;
  11       function Func (V : New_I) return access I'Class;
  12    end Pkg;
  13
  14    package body Pkg is
  15       X : aliased New_I;
  16
  17       procedure Proc (V : access I'Class) is begin null; end Proc;
  18
  19       function Func (V : New_I) return access I'Class is
  20       begin
  21          X := V;
  22          return X'Access;
  23       end Func;
  24    end Pkg;
  25
  26    use Pkg;
  27
  28    New_I_Obj : aliased New_I;
  29
  30    procedure Proc2 (V : access I'Class) is
  31    begin
  32       Proc (Func (V.all));  -- Call to Func causes gigi abort 122
  33    end Proc2;
  34
  35 begin
  36    Proc2 (New_I_Obj'Access);
  37 end Abstract_With_Anonymous_Result;