view gcc/testsuite/gfortran.dg/class_result_5.f90 @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900 (2020-02-13)
parents 84e7813d76e9
children
line wrap: on
line source
! { dg-do run }
!
! Test the fix for PR79072. The original problem was that an ICE
! would occur in the select type construct. On fixing that, it was
! found that the string length was not being transferred in the
! pointer assignment in the main program.
!
! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
!
function foo(string)
  class(*), pointer :: foo
  character(3), target :: string
  foo => string
  select type (foo)
    type is (character(*))
      if (foo .ne. 'foo') STOP 1
      foo = 'bar'
  end select
end function

  interface
    function foo(string)
      class(*), pointer :: foo
      character(3), target :: string
    end function
  end interface

  class(*), pointer :: res
  character(3), target :: string = 'foo'

  res => foo (string)

  select type (res)
    type is (character(*))
      if (res .ne. 'bar') STOP 2
  end select
  if (string .ne. 'bar') STOP 3
end