summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gnat.dg/align_max.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gnat.dg/align_max.adb')
-rw-r--r--gcc/testsuite/gnat.dg/align_max.adb137
1 files changed, 137 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/align_max.adb b/gcc/testsuite/gnat.dg/align_max.adb
new file mode 100644
index 000000000..26597ea96
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/align_max.adb
@@ -0,0 +1,137 @@
+-- { dg-do run }
+
+with System.Storage_Elements; use System.Storage_Elements;
+with Ada.Unchecked_Deallocation;
+
+procedure Align_MAX is
+
+ Align : constant := Standard'Maximum_Alignment;
+
+ generic
+ type Data_Type (<>) is private;
+ type Access_Type is access Data_Type;
+ with function Allocate return Access_Type;
+ with function Address (Ptr : Access_Type) return System.Address;
+ package Check is
+ -- The hooks below just force asm generation that helps associating
+ -- obscure nested function names with their package instance name.
+ Hook_Allocate : System.Address := Allocate'Address;
+ Hook_Address : System.Address := Address'Address;
+ pragma Volatile (Hook_Allocate);
+ pragma Volatile (Hook_Address);
+
+ procedure Run (Announce : String);
+ end;
+
+ package body Check is
+
+ procedure Free is new
+ Ada.Unchecked_Deallocation (Data_Type, Access_Type);
+
+ procedure Run (Announce : String) is
+ Addr : System.Address;
+ Blocks : array (1 .. 1024) of Access_Type;
+ begin
+ for J in Blocks'Range loop
+ Blocks (J) := Allocate;
+ Addr := Address (Blocks (J));
+ if Addr mod Data_Type'Alignment /= 0 then
+ raise Program_Error;
+ end if;
+ end loop;
+
+ for J in Blocks'Range loop
+ Free (Blocks (J));
+ end loop;
+ end;
+ end;
+
+begin
+ declare
+ type Array_Type is array (Integer range <>) of Integer;
+ for Array_Type'Alignment use Align;
+
+ type FAT_Array_Access is access all Array_Type;
+
+ function Allocate return FAT_Array_Access is
+ begin
+ return new Array_Type (1 .. 1);
+ end;
+
+ function Address (Ptr : FAT_Array_Access) return System.Address is
+ begin
+ return Ptr(1)'Address;
+ end;
+ package Check_FAT is new
+ Check (Array_Type, FAT_Array_Access, Allocate, Address);
+ begin
+ Check_FAT.Run ("Checking FAT pointer to UNC array");
+ end;
+
+ declare
+ type Array_Type is array (Integer range <>) of Integer;
+ for Array_Type'Alignment use Align;
+
+ type THIN_Array_Access is access all Array_Type;
+ for THIN_Array_Access'Size use Standard'Address_Size;
+
+ function Allocate return THIN_Array_Access is
+ begin
+ return new Array_Type (1 .. 1);
+ end;
+
+ function Address (Ptr : THIN_Array_Access) return System.Address is
+ begin
+ return Ptr(1)'Address;
+ end;
+ package Check_THIN is new
+ Check (Array_Type, THIN_Array_Access, Allocate, Address);
+ begin
+ Check_THIN.Run ("Checking THIN pointer to UNC array");
+ end;
+
+ declare
+ type Array_Type is array (Integer range 1 .. 1) of Integer;
+ for Array_Type'Alignment use Align;
+
+ type Array_Access is access all Array_Type;
+
+ function Allocate return Array_Access is
+ begin
+ return new Array_Type;
+ end;
+
+ function Address (Ptr : Array_Access) return System.Address is
+ begin
+ return Ptr(1)'Address;
+ end;
+ package Check_Array is new
+ Check (Array_Type, Array_Access, Allocate, Address);
+ begin
+ Check_Array.Run ("Checking pointer to constrained array");
+ end;
+
+ declare
+ type Record_Type is record
+ Value : Integer;
+ end record;
+ for Record_Type'Alignment use Align;
+
+ type Record_Access is access all Record_Type;
+
+ function Allocate return Record_Access is
+ begin
+ return new Record_Type;
+ end;
+
+ function Address (Ptr : Record_Access) return System.Address is
+ begin
+ return Ptr.all'Address;
+ end;
+ package Check_Record is new
+ Check (Record_Type, Record_Access, Allocate, Address);
+ begin
+ Check_Record.Run ("Checking pointer to record");
+ end;
+end;
+