gcc/testsuite/gfortran.dg/select_rank_6.f90

   1 ! { dg-do compile }
   2 ! PR fortran/100607 - fix diagnostics for SELECT RANK
   3 ! Contributed by T.Burnus
   4
   5 program p
   6   implicit none
   7   integer, allocatable :: A(:,:,:)
   8
   9   allocate(a(5:6,-2:2, 99:100))
  10   call foo(a)
  11   call bar(a)
  12
  13 contains
  14
  15   subroutine foo(x)
  16     integer, allocatable :: x(..)
  17     if (rank(x) /= 3) stop 1
  18     if (any (lbound(x) /= [5, -2, 99])) stop 2
  19
  20     select rank (x)
  21     rank(3)
  22       if (any (lbound(x) /= [5, -2, 99])) stop 3
  23     end select
  24
  25     select rank (x) ! { dg-error "pointer or allocatable selector at .2." }
  26     rank(*)         ! { dg-error "pointer or allocatable selector at .2." }
  27       if (rank(x) /= 1) stop 4
  28       if (lbound(x, 1) /= 1) stop 5
  29     end select
  30   end
  31
  32   subroutine bar(x)
  33     integer :: x(..)
  34     if (rank(x) /= 3) stop 6
  35     if (any (lbound(x) /= 1)) stop 7
  36
  37     select rank (x)
  38     rank(3)
  39       if (any (lbound(x) /= 1)) stop 8
  40     end select
  41
  42     select rank (x)
  43     rank(*)
  44       if (rank(x) /= 1) stop 9
  45       if (lbound(x, 1) /= 1) stop 10
  46     end select
  47   end
  48 end