gcc/testsuite/gnat.dg/allocator_maxalign1.adb

   1 --  { dg-do run }
   2
   3 with System.Storage_Elements; use System.Storage_Elements;
   4 with Ada.Unchecked_Deallocation;
   5
   6 procedure Allocator_Maxalign1 is
   7
   8    Max_Alignment : constant := Standard'Maximum_Alignment;
   9
  10    type Block is record
  11       X : Integer;
  12    end record;
  13    for Block'Alignment use Standard'Maximum_Alignment;
  14
  15    type Block_Access is access all Block;
  16    procedure Free is new Ada.Unchecked_Deallocation (Block, Block_Access);
  17
  18    N_Blocks : constant := 500;
  19    Blocks   : array (1 .. N_Blocks) of Block_Access;
  20 begin
  21    if Block'Alignment /= Max_Alignment then
  22       raise Program_Error;
  23    end if;
  24
  25    for K in 1 .. 4 loop
  26
  27       for I in Blocks'Range loop
  28          Blocks (I) := new Block;
  29          if Blocks (I).all'Address mod Block'Alignment /= 0 then
  30             raise Program_Error;
  31          end if;
  32          Blocks(I).all.X := I;
  33       end loop;
  34
  35       for I in Blocks'Range loop
  36          Free (Blocks (I));
  37       end loop;
  38
  39    end loop;
  40
  41 end;
  42