gcc/testsuite/gfortran.dg/proc_ptr_comp_17.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 41106: [F03] Procedure Pointers with CHARACTER results
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 module m
   8  type :: t
   9  procedure(abc), pointer, nopass :: ptr
  10  end type
  11 contains
  12  function abc(arg)
  13   character(len=5),pointer :: abc
  14   character(len=5),target :: arg
  15   abc => arg
  16  end function abc
  17 end module m
  18
  19 use m
  20  type(t) :: x
  21  character(len=5) :: str = 'abcde'
  22  character(len=5), pointer :: strptr
  23  x%ptr => abc
  24  print *,x%ptr(str)
  25  strptr => x%ptr(str)
  26  if (strptr/='abcde') call abort()
  27  str = 'fghij'
  28  if (strptr/='fghij') call abort()
  29 end
  30
  31 ! { dg-final { cleanup-modules "m" } }
  32