gcc/testsuite/gfortran.dg/select_rank_5.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fixes for PR97723 and PR97694.
   4 !
   5 ! Contributed by Martin  <mscfd@gmx.net>
   6 !
   7 module mod
   8    implicit none
   9    private
  10    public cssel
  11
  12 contains
  13
  14 function cssel(x) result(s)
  15    character(len=:), allocatable :: s
  16    class(*), dimension(..), optional, intent(in) :: x
  17    if (present(x)) then
  18       select rank (x)
  19       rank (0)
  20          s = '0' ! PR97723: ‘assign’ at (1) is not a function
  21                  ! PR97694: ICE in trans-stmt.c(trans_associate_var)
  22       rank (1)
  23          s = '1' ! PR97723: ‘assign’ at (1) is not a function
  24       rank default
  25          s = '?' ! PR97723: ‘assign’ at (1) is not a function
  26       end select
  27    else
  28       s = '-'
  29    end if
  30 end function cssel
  31
  32 end module mod
  33
  34 program classstar_rank
  35    use mod
  36    implicit none
  37
  38    integer :: x
  39    real, dimension(1:3) :: y
  40    logical, dimension(1:2,1:2) :: z
  41
  42    if (any ([cssel(x),cssel(y),cssel(z),cssel()] .ne. ['0','1','?','-'])) stop 1
  43
  44 end program classstar_rank