gcc/testsuite/gfortran.dg/assumed_rank_8.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources assumed_rank_8_c.c }
   3 !
   4 ! PR fortran/48820
   5 !
   6 ! Scalars to assumed-rank tests
   7 !
   8 program main
   9   implicit none
  10
  11   interface
  12     subroutine check (x)
  13       integer :: x(..)
  14     end subroutine check
  15   end interface
  16
  17   integer, target :: ii, j
  18   integer, allocatable :: kk
  19   integer, pointer :: ll
  20   ii = 489
  21   j = 0
  22   call f (ii)
  23   call f (489)
  24   call f ()
  25   call f (null())
  26   call f (kk)
  27   if (j /= 2) STOP 1
  28
  29   j = 0
  30   nullify (ll)
  31   call g (null())
  32   call g (ll)
  33   call g (ii)
  34   if (j /= 1) STOP 2
  35
  36   j = 0
  37   call h (kk)
  38   kk = 489
  39   call h (kk)
  40   if (j /= 1) STOP 3
  41
  42 contains
  43
  44   subroutine f (x)
  45     integer, optional :: x(..)
  46
  47     if (.not. present (x)) return
  48     if (rank (x) /= 0) STOP 1
  49     call check (x)
  50     j = j + 1
  51   end subroutine
  52
  53   subroutine g (x)
  54     integer, pointer, intent(in) :: x(..)
  55
  56     if (.not. associated (x)) return
  57     if (rank (x) /= 0) STOP 4
  58     call check (x)
  59     j = j + 1
  60   end subroutine
  61
  62   subroutine h (x)
  63     integer, allocatable :: x(..)
  64
  65     if (.not. allocated (x)) return
  66     if (rank (x) /= 0) STOP 2
  67     call check (x)
  68     j = j + 1
  69   end subroutine
  70
  71 end program main