gcc/testsuite/gnat.dg/pak.adb

   1 --  { dg-do compile }
   2 package body Pak is
   3    pragma Suppress (Discriminant_Check);
   4    --  Suppress discriminant check to prevent the assignment from using
   5    --  the predefined primitive _assign.
   6
   7    procedure Initialize (X : in out T) is begin null; end Initialize;
   8    procedure Finalize (X : in out T) is begin null; end Finalize;
   9
  10    procedure Assign (X : out T'Class) is
  11       Y : T;
  12    begin
  13       T (X) := Y;
  14    end Assign;
  15 end Pak;