gcc/testsuite/gfortran.dg/PR100098.f90

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