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!
8module 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
17contains
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
27end module m
28
29program 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
45end program p
46