OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [alignment2.adb] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 696 jeremybenn
-- { dg-do run }
2
 
3
procedure 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
 
42
begin
43
   q (L1.LEVEL2_PTR);
44
   if L1.LEVEL2_PTR (1) /= L2'Access then
45
     raise Program_Error;
46
   end if;
47
end;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.