gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR77703, in which calls of the pointer function
   4 ! caused an ICE in 'gfc_trans_auto_character_variable'.
   5 !
   6 ! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
   7 !
   8 module m
   9    implicit none
  10    private
  11    integer, parameter, public :: n = 2
  12    integer, parameter :: ell = 6
  13
  14    character(len=n*ell), target, public :: s
  15
  16    public :: t
  17 contains
  18    function t( idx ) result( substr )
  19       integer, intent(in) :: idx
  20       character(len=ell), pointer  :: substr
  21
  22       if ( (idx < 0).or.(idx > n) ) then
  23          error stop
  24       end if
  25       substr => s((idx-1)*ell+1:idx*ell)
  26    end function t
  27 end module m
  28
  29 program p
  30    use m, only : s, t, n
  31    integer :: i
  32
  33    ! Define 's'
  34    s = "123456789012"
  35
  36    ! Then perform operations involving 't'
  37    if (t(1) .ne. "123456") stop 1
  38    if (t(2) .ne. "789012") stop 2
  39
  40    ! Do the pointer function assignments
  41    t(1) = "Hello "
  42    if (s .ne. "Hello 789012") Stop 3
  43    t(2) = "World!"
  44    if (s .ne. "Hello World!") Stop 4
  45 end program p