URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [sizeof.f90] - Rev 801
Go to most recent revision | Compare with Previous | Blame | View Log
! { dg-do run }
! Verify that the sizeof intrinsic does as advertised
subroutine check_int (j)
INTEGER(4) :: i, ia(5), ib(5,4), ip, ipa(:)
target :: ib
POINTER :: ip, ipa
logical :: l(6)
integer(8) :: jb(5,4)
if (sizeof (jb) /= 2*sizeof (ib)) call abort
if (sizeof(j) == 4) then
if (sizeof (j) /= sizeof (i)) call abort
else
if (sizeof (j) /= 2 * sizeof (i)) call abort
end if
ipa=>ib(2:3,1)
l = (/ sizeof(i) == 4, sizeof(ia) == 20, sizeof(ib) == 80, &
sizeof(ip) == 4, sizeof(ipa) == 8, sizeof(ib(1:5:2,3)) == 12 /)
if (any(.not.l)) call abort
if (sizeof(l) /= 6*sizeof(l(1))) call abort
end subroutine check_int
subroutine check_real (x, y)
dimension y(5)
real(4) :: r(20,20,20), rp(:,:)
target :: r
pointer :: rp
double precision :: d(5,5)
complex(kind=4) :: c(5)
if (sizeof (y) /= 5*sizeof (x)) call abort
if (sizeof (r) /= 8000*4) call abort
rp => r(5,2:10,1:5)
if (sizeof (rp) /= 45*4) call abort
rp => r(1:5,1:5,1)
if (sizeof (d) /= 2*sizeof (rp)) call abort
if (sizeof (c(1)) /= 2*sizeof(r(1,1,1))) call abort
end subroutine check_real
subroutine check_derived ()
type dt
integer i
end type dt
type (dt) :: a
integer :: i
type foo
integer :: i(5000)
real :: j(5)
type(dt) :: d
end type foo
type bar
integer :: j(5000)
real :: k(5)
type(dt) :: d
end type bar
type (foo) :: oof
type (bar) :: rab
integer(8) :: size_500, size_200, sizev500, sizev200
type all
real, allocatable :: r(:)
end type all
real :: r(200), s(500)
type(all) :: v
if (sizeof(a) /= sizeof(i)) call abort
if (sizeof(oof) /= sizeof(rab)) call abort
allocate (v%r(500))
sizev500 = sizeof (v)
size_500 = sizeof (v%r)
deallocate (v%r)
allocate (v%r(200))
sizev200 = sizeof (v)
size_200 = sizeof (v%r)
deallocate (v%r)
if (size_500 - size_200 /= sizeof(s) - sizeof(r) .or. sizev500 /= sizev200) &
call abort
end subroutine check_derived
call check_int (1)
call check_real (1.0, (/1.0, 2.0, 3.0, 4.0, 5.0/))
call check_derived ()
end
Go to most recent revision | Compare with Previous | Blame | View Log