OSDN Git Service

PR debug/43329
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / sizeof.f90
1 ! { dg-do run }
2 ! Verify that the sizeof intrinsic does as advertised
3 subroutine 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
26 end subroutine check_int
27
28 subroutine 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
44 end subroutine check_real
45
46 subroutine 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
83 end subroutine check_derived
84
85 call check_int ()
86 call check_real ()
87 call check_derived ()
88 end