1!RUN: %f18 -fdebug-dump-symbols -fparse-only %s | FileCheck %s
2
3! Size and alignment of intrinsic types
4subroutine s1
5  integer(1) :: a_i1  !CHECK: a_i1 size=1 offset=0:
6  integer(8) :: b_i8  !CHECK: b_i8 size=8 offset=8:
7  real(2)    :: c_r2  !CHECK: c_r2 size=2 offset=16:
8  real(2)    :: d_r2  !CHECK: d_r2 size=2 offset=18:
9  real(8)    :: e_r8  !CHECK: e_r8 size=8 offset=24:
10  real(4)    :: f_r4  !CHECK: f_r4 size=4 offset=32:
11  complex(8) :: g_c8  !CHECK: g_c8 size=16 offset=40:
12  complex(4) :: h_c4  !CHECK: h_c4 size=8 offset=56:
13  logical    :: i_l4  !CHECK: i_l4 size=4 offset=64:
14end
15
16! Character
17subroutine s2
18  character(10)        :: c1 !CHECK: c1 size=10 offset=0:
19  character(1)         :: c2 !CHECK: c2 size=1 offset=10:
20  character(10,kind=2) :: c3 !CHECK: c3 size=20 offset=12:
21end
22
23! Descriptors
24subroutine s3(n)
25  integer :: n
26  real, pointer :: x !CHECK: x, POINTER size=24 offset=8:
27  character(n)  :: y !CHECK: y size=24 offset=32:
28end
29
30! Descriptors for arrays
31subroutine s4
32  integer, allocatable :: z0        !CHECK: z0, ALLOCATABLE size=24 offset=
33  integer, allocatable :: z1(:)     !CHECK: z1, ALLOCATABLE size=48 offset=
34  integer, allocatable :: z2(:,:)   !CHECK: z2, ALLOCATABLE size=72 offset=
35  integer, allocatable :: z3(:,:,:) !CHECK: z3, ALLOCATABLE size=96 offset=
36end
37
38! Descriptors with length parameters
39subroutine s5(n)
40  integer :: n
41  type :: t1(l)
42    integer, len :: l
43    real :: a(l)
44  end type
45  type :: t2(l1, l2)
46    integer, len :: l1
47    integer, len :: l2
48    real :: b(l1, l2)
49  end type
50  type(t1(n))   :: x1 !CHECK: x1 size=48 offset=
51  type(t2(n,n)) :: x2 !CHECK: x2 size=56 offset=
52  !CHECK: a size=48 offset=0:
53  !CHECK: b size=72 offset=0:
54end
55