gcc/testsuite/gnat.dg/limited1_inner.adb


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

package body Limited1_Inner is
   overriding procedure Finalize (X : in out Limited_Type) is
   begin
      if X.Self /= X'Unrestricted_Access then
         raise Program_Error with "Copied!";
      end if;
   end;

   function Make_Inner return Inner_Type is
   begin
      return Inner : Inner_Type (True) do
         null;
      end return;
   end;
end;