gcc/testsuite/gfortran.dg/unlimited_polymorphic_14.f90

   1 ! { dg-do run }
   2 !
   3 ! Uncovered in fixing PR fortran/58793
   4 !
   5 ! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
   6 !
   7 ! Barfed on the hollerith argument
   8 !
   9 program test
  10   logical l
  11   call up("abc", l)
  12   if (l) call abort
  13   call up(3habc, l) ! { dg-warning "Legacy Extension" }
  14   if (.not. l) call abort
  15 contains
  16   subroutine up(x, l)
  17     class(*) :: x
  18     logical l
  19     select type(x)
  20      type is (character(*))
  21       l = .false.
  22      class default
  23       l = .true.
  24     end select
  25   end subroutine
  26 end program test