gcc/testsuite/gfortran.dg/deferred_type_param_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/51055
   4 ! PR fortran/49110
   5 ! PR fortran/60334
   6
   7 subroutine test()
   8   implicit none
   9   integer :: i = 5
  10   character(len=:), allocatable :: s1
  11   character(len=:), pointer :: s2
  12   character(len=5), target :: fifeC = 'FIVEC'
  13   call sub(s1, i)
  14   if (len(s1) /= 5) call abort()
  15   if (s1 /= "ZZZZZ") call abort()
  16   s2 => subfunc()
  17   if (len(s2) /= 5) call abort()
  18   if (s2 /= "FIVEC") call abort()
  19   s1 = addPrefix(subfunc())
  20   if (len(s1) /= 7) call abort()
  21   if (s1 /= "..FIVEC") call abort()
  22 contains
  23   subroutine sub(str,j)
  24     character(len=:), allocatable :: str
  25     integer :: j
  26     str = REPEAT("Z",j)
  27     if (len(str) /= 5) call abort()
  28     if (str /= "ZZZZZ") call abort()
  29   end subroutine sub
  30   function subfunc() result(res)
  31     character(len=:), pointer :: res
  32     res => fifec
  33     if (len(res) /= 5) call abort()
  34     if (res /= "FIVEC") call abort()
  35   end function subfunc
  36   function addPrefix(str) result(res)
  37     character(len=:), pointer :: str
  38     character(len=:), allocatable :: res
  39     res = ".." // str
  40   end function addPrefix
  41 end subroutine test
  42
  43 program a
  44  character(len=:),allocatable :: s
  45  integer :: j=2
  46  s = repeat ('x', j)
  47  if (len(repeat(' ',j)) /= 2) call abort()
  48  if (repeat('y',j) /= "yy") call abort()
  49  if (len(s) /= 2) call abort()
  50  if (s /= "xx") call abort()
  51  call test()
  52 end program a