gcc/testsuite/gfortran.dg/select_rank_2.f90

   1 ! { dg-do compile }
   2 !
   3 ! Basic tests of SELECT RANK
   4 !
   5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   6 !
   7 subroutine foo1 (arg)
   8   integer :: i
   9   integer, dimension(3) :: arg
  10   select rank (arg)   ! { dg-error "must be an assumed rank variable" }
  11     rank (3)          ! { dg-error "Unexpected RANK statement" }
  12     print *, arg
  13   end select          ! { dg-error "Expecting END SUBROUTINE" }
  14 end
  15
  16 subroutine foo2 (arg)
  17   integer :: i
  18   integer, dimension(..) :: arg
  19   select rank (arg)
  20     rank (i)          ! { dg-error "must be a scalar" }
  21     print *, arg      ! { dg-error "Expected RANK or RANK DEFAULT" }
  22   end select
  23 end
  24
  25 subroutine foo3 (arg)
  26   integer :: i
  27   integer, parameter :: r = 3
  28   integer, dimension(..) :: arg
  29   select rank (arg)
  30     rank (16)         ! { dg-error "must not be less than zero or greater than 15" }
  31     print *, arg      ! { dg-error "Expected RANK or RANK DEFAULT" }
  32     rank (-1)         ! { dg-error "must not be less than zero or greater than 15" }
  33     print *, arg      ! { dg-error "Expected RANK or RANK DEFAULT" }
  34     rank (r)          ! OK
  35     print *, arg
  36   end select
  37 end
  38
  39 subroutine foo4 (arg)
  40   integer :: i
  41   integer, dimension(..), pointer :: arg
  42   select rank (arg)   ! { dg-error "cannot be used with the pointer or allocatable selector" }
  43     rank (*)          ! { dg-error "cannot be used with the pointer or allocatable selector" }
  44     print *, arg(1:1)
  45     rank (1)
  46     print *, arg
  47   end select
  48 end
  49
  50 subroutine foo5 (arg)
  51   integer :: i
  52   integer, dimension(..), ALLOCATABLE :: arg
  53   select rank (arg)   ! { dg-error "cannot be used with the pointer or allocatable selector" }
  54     rank (*)          ! { dg-error "pointer or allocatable selector|deferred shape or assumed rank" }
  55     print *, arg(1:1)
  56     rank (1)
  57     print *, arg
  58   end select
  59 end
  60
  61 subroutine foo6 (arg)
  62   integer :: i
  63   integer, dimension(..) :: arg
  64   select rank (arg)
  65     rank (*)
  66     print *, arg      ! { dg-error "assumed.size array" }
  67     rank (1)
  68     print *, arg
  69   end select
  70 end
  71
  72 subroutine foo7 (arg)
  73   integer :: i
  74   integer, dimension(..) :: arg
  75   select rank (arg)
  76     rank (1)          ! { dg-error "is repeated" }
  77       arg = 1
  78     rank (1)          ! { dg-error "is repeated" }
  79       arg = 1
  80     rank (*)          ! { dg-error "is repeated" }
  81     rank (*)          ! { dg-error "is repeated" }
  82     rank default      ! { dg-error "is repeated" }
  83     rank default      ! { dg-error "is repeated" }
  84   end select
  85 end