gcc/testsuite/gfortran.dg/allocate_with_source_18.f03

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/57365
   4 ! [OOP] Sourced allocation fails with unlimited polymorphism
   5 ! Contributed by <rxs@hotmail.de>
   6 !
   7 program bug
   8
   9     implicit none
  10     character(len=:), allocatable :: test
  11
  12     test = "A test case"
  13     call allocate_test(test)
  14     deallocate(test)
  15
  16 contains
  17
  18     subroutine allocate_test(var)
  19         class(*) :: var
  20         class(*), pointer :: copyofvar
  21         allocate(copyofvar, source=var)
  22         select type (copyofvar)
  23             type is (character(len=*))
  24 !                print*, len(copyofvar), copyofvar
  25                 if (len(copyofvar) /= 11) STOP 1
  26                 if (copyofvar /= "A test case") STOP 2
  27         end select
  28         deallocate(copyofvar)
  29     end subroutine
  30
  31 end program bug