view gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents
children
line wrap: on
line source

! { dg-do run }
!
! Test the fix for PR77703, in which calls of the pointer function
! caused an ICE in 'gfc_trans_auto_character_variable'.
!
! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
!
module m
   implicit none
   private
   integer, parameter, public :: n = 2
   integer, parameter :: ell = 6

   character(len=n*ell), target, public :: s

   public :: t
contains
   function t( idx ) result( substr )
      integer, intent(in) :: idx
      character(len=ell), pointer  :: substr

      if ( (idx < 0).or.(idx > n) ) then
         error stop
      end if
      substr => s((idx-1)*ell+1:idx*ell)
   end function t
end module m

program p
   use m, only : s, t, n
   integer :: i

   ! Define 's'
   s = "123456789012"

   ! Then perform operations involving 't'
   if (t(1) .ne. "123456") stop 1
   if (t(2) .ne. "789012") stop 2

   ! Do the pointer function assignments
   t(1) = "Hello "
   if (s .ne. "Hello 789012") Stop 3
   t(2) = "World!"
   if (s .ne. "Hello World!") Stop 4
end program p