1! { dg-do run }
2! Verify that the sizeof intrinsic does as advertised
3subroutine check_int (j)
4  INTEGER(4) :: i, ia(5), ib(5,4), ip, ipa(:)
5  target :: ib
6  POINTER :: ip, ipa
7  logical :: l(6)
8  integer(8) :: jb(5,4)
9
10  if (sizeof (jb) /= 2*sizeof (ib)) call abort
11
12  if (sizeof(j) == 4) then
13     if (sizeof (j) /= sizeof (i)) call abort
14  else
15     if (sizeof (j) /= 2 * sizeof (i)) call abort
16  end if
17
18  ipa=>ib(2:3,1)
19
20  l = (/ sizeof(i) == 4, sizeof(ia) == 20, sizeof(ib) == 80, &
21       sizeof(ip) == 4, sizeof(ipa) == 8, sizeof(ib(1:5:2,3)) == 12 /)
22
23  if (any(.not.l)) call abort
24
25  if (sizeof(l) /= 6*sizeof(l(1))) call abort
26end subroutine check_int
27
28subroutine check_real (x, y)
29  dimension y(5)
30  real(4) :: r(20,20,20), rp(:,:)
31  target :: r
32  pointer :: rp
33  double precision :: d(5,5)
34  complex(kind=4) :: c(5)
35
36  if (sizeof (y) /= 5*sizeof (x)) call abort
37
38  if (sizeof (r) /= 8000*4) call abort
39  rp => r(5,2:10,1:5)
40  if (sizeof (rp) /= 45*4) call abort
41  rp => r(1:5,1:5,1)
42  if (sizeof (d) /= 2*sizeof (rp)) call abort
43  if (sizeof (c(1)) /= 2*sizeof(r(1,1,1))) call abort
44end subroutine check_real
45
46subroutine check_derived ()
47  type dt
48     integer i
49  end type dt
50  type (dt) :: a
51  integer :: i
52  type foo
53     integer :: i(5000)
54     real :: j(5)
55     type(dt) :: d
56  end type foo
57  type bar
58     integer :: j(5000)
59     real :: k(5)
60     type(dt) :: d
61  end type bar
62  type (foo) :: oof
63  type (bar) :: rab
64  integer(8) :: size_500, size_200, sizev500, sizev200
65  type all
66     real, allocatable :: r(:)
67  end type all
68  real :: r(200), s(500)
69  type(all) :: v
70
71  if (sizeof(a) /= sizeof(i)) call abort
72  if (sizeof(oof) /= sizeof(rab)) call abort
73  allocate (v%r(500))
74  sizev500 = sizeof (v)
75  size_500 = sizeof (v%r)
76  deallocate (v%r)
77  allocate (v%r(200))
78  sizev200 = sizeof (v)
79  size_200 = sizeof (v%r)
80  deallocate (v%r)
81  if (size_500 - size_200 /= sizeof(s) - sizeof(r) .or. sizev500 /= sizev200) &
82       call abort
83end subroutine check_derived
84
85call check_int (1)
86call check_real (1.0, (/1.0, 2.0, 3.0, 4.0, 5.0/))
87call check_derived ()
88end
89