gcc/testsuite/gnat.dg/tagged_type_pkg.adb

   1 package body Tagged_Type_Pkg is
   2
   3    function Pass_TT_Access (Obj : access TT'Class) return access TT'Class is
   4    begin
   5       if Obj = null then
   6          return null;
   7
   8       else
   9          --  The implicit conversion in the assignment to the return object
  10          --  must fail if Obj's actual is not a library-level object.
  11
  12          return TT_Acc : access TT'Class := Obj do
  13             TT_Acc := TT_Acc.Self;
  14          end return;
  15       end if;
  16    end Pass_TT_Access;
  17
  18 end Tagged_Type_Pkg;