gcc/testsuite/gfortran.dg/PR100097.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR100097
   5 !
   6
   7 program main_p
   8   implicit none
   9
  10   class(*), pointer     :: bar_p(:)
  11   class(*), allocatable :: bar_a(:)
  12
  13   call foo_p(bar_p)
  14   call foo_a(bar_a)
  15
  16 contains
  17
  18   subroutine foo_p(that)
  19     class(*), pointer, intent(out) :: that(..)
  20
  21     select rank(that)
  22     rank(1)
  23     rank default
  24       stop 1
  25     end select
  26   end subroutine foo_p
  27
  28   subroutine foo_a(that)
  29     class(*), allocatable, intent(out) :: that(..)
  30
  31     select rank(that)
  32     rank(1)
  33     rank default
  34       stop 2
  35     end select
  36   end subroutine foo_a
  37
  38 end program main_p
  39
  40 ! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.* .rank=1,.*\\}" "original" } }
  41 ! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.* .rank=1,.*\\}" "original" } }