1-- { dg-do run } 2 3procedure alignment2 is 4 5 pragma COMPONENT_ALIGNMENT(STORAGE_UNIT); 6 7 MAX_LIST_SIZE : constant INTEGER := 128*16; 8 9 LEVEL2_SIZE : constant INTEGER := 128; 10 11 LEVEL1_SIZE : constant INTEGER 12 := (MAX_LIST_SIZE - 1) / LEVEL2_SIZE + 1; 13 14 type LEVEL2_ARRAY_TYPE is 15 array (1..LEVEL2_SIZE) of Integer; 16 17 type LEVEL2_TYPE is 18 record 19 NUM : INTEGER := 0; 20 DATA : LEVEL2_ARRAY_TYPE := ( others => 0 ); 21 end record; 22 23 type LEVEL2_PTR_TYPE is access all LEVEL2_TYPE; 24 25 type LEVEL1_ARRAY_TYPE is 26 array( 1..LEVEL1_SIZE ) of LEVEL2_PTR_TYPE; 27 28 type LEVEL1_TYPE is 29 record 30 LAST_LINE : INTEGER := 0; 31 LEVEL2_PTR : LEVEL1_ARRAY_TYPE; 32 end record; 33 34 L1 : LEVEL1_TYPE; 35 L2 : aliased LEVEL2_TYPE; 36 37 procedure q (LA : in out LEVEL1_ARRAY_TYPE) is 38 begin 39 LA (1) := L2'Access; 40 end; 41 42begin 43 q (L1.LEVEL2_PTR); 44 if L1.LEVEL2_PTR (1) /= L2'Access then 45 raise Program_Error; 46 end if; 47end; 48