I will apply this as 'obvious' this evening, unless there are
objections. The patch is entirely self-explanatory.
Paul
2018-12-23 Paul Thomas <[email protected]>
PR fortran/77703
* resolve.c (get_temp_from_expr): Use the string length of
constant character expressions.
2018-12-23 Paul Thomas <[email protected]>
PR fortran/77703
* gfortran.dg/ptr_func_assign_5.f08 : New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 267336)
--- gcc/fortran/resolve.c (working copy)
*************** get_temp_from_expr (gfc_expr *e, gfc_nam
*** 10637,10642 ****
--- 10637,10647 ----
gfc_get_sym_tree (name, ns, &tmp, false);
gfc_add_type (tmp->n.sym, &e->ts, NULL);
+ if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_CHARACTER)
+ tmp->n.sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
+ NULL,
+ e->value.character.length);
+
as = NULL;
ref = NULL;
aref = NULL;
Index: gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08
===================================================================
*** gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 (nonexistent)
--- gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 (working copy)
***************
*** 0 ****
--- 1,45 ----
+ ! { 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 <[email protected]>
+ !
+ 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
