Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/assumed_rank_8.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_8.f90 Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,71 @@ +! { dg-do run } +! { dg-additional-sources assumed_rank_8_c.c } +! +! PR fortran/48820 +! +! Scalars to assumed-rank tests +! +program main + implicit none + + interface + subroutine check (x) + integer :: x(..) + end subroutine check + end interface + + integer, target :: ii, j + integer, allocatable :: kk + integer, pointer :: ll + ii = 489 + j = 0 + call f (ii) + call f (489) + call f () + call f (null()) + call f (kk) + if (j /= 2) call abort() + + j = 0 + nullify (ll) + call g (null()) + call g (ll) + call g (ii) + if (j /= 1) call abort() + + j = 0 + call h (kk) + kk = 489 + call h (kk) + if (j /= 1) call abort() + +contains + + subroutine f (x) + integer, optional :: x(..) + + if (.not. present (x)) return + if (rank (x) /= 0) call abort + call check (x) + j = j + 1 + end subroutine + + subroutine g (x) + integer, pointer, intent(in) :: x(..) + + if (.not. associated (x)) return + if (rank (x) /= 0) call abort () + call check (x) + j = j + 1 + end subroutine + + subroutine h (x) + integer, allocatable :: x(..) + + if (.not. allocated (x)) return + if (rank (x) /= 0) call abort + call check (x) + j = j + 1 + end subroutine + +end program main