gcc/testsuite/gnat.dg/unc_memfree.adb

   1 --  { dg-do run }
   2
   3 with Ada.Unchecked_Deallocation;
   4 with Unc_Memops;
   5
   6 procedure Unc_Memfree is
   7
   8    type List is array (Natural range <>) of Integer;
   9    for List'Alignment use Standard'Maximum_Alignment;
  10
  11    type Fat_List_Access is access all List;
  12
  13    type Thin_List_Access is access all List;
  14    for Thin_List_Access'Size use Standard'Address_Size;
  15
  16    procedure Release_Fat is new Ada.Unchecked_Deallocation
  17      (Object => List, Name => Fat_List_Access);
  18
  19    procedure Release_Thin is new Ada.Unchecked_Deallocation
  20      (Object => List, Name => Thin_List_Access);
  21
  22    My_Fat_List : Fat_List_Access;
  23    My_Thin_List : Thin_List_Access;
  24 begin
  25    Unc_Memops.Expect_Symetry (True);
  26
  27    My_Fat_List := new List (1 .. 3);
  28    Release_Fat (My_Fat_List);
  29
  30    My_Thin_List := new List (1 .. 3);
  31    Release_Thin (My_Thin_List);
  32
  33    Unc_Memops.Expect_Symetry (False);
  34 end;