gcc/testsuite/gfortran.dg/class_result_5.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR79072. The original problem was that an ICE
   4 ! would occur in the select type construct. On fixing that, it was
   5 ! found that the string length was not being transferred in the
   6 ! pointer assignment in the main program.
   7 !
   8 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   9 !
  10 function foo(string)
  11   class(*), pointer :: foo
  12   character(3), target :: string
  13   foo => string
  14   select type (foo)
  15     type is (character(*))
  16       if (foo .ne. 'foo') call abort
  17       foo = 'bar'
  18   end select
  19 end function
  20
  21   interface
  22     function foo(string)
  23       class(*), pointer :: foo
  24       character(3), target :: string
  25     end function
  26   end interface
  27
  28   class(*), pointer :: res
  29   character(3), target :: string = 'foo'
  30
  31   res => foo (string)
  32
  33   select type (res)
  34     type is (character(*))
  35       if (res .ne. 'bar') call abort
  36   end select
  37   if (string .ne. 'bar') call abort
  38 end