re PR fortran/77703 (ICE on assignment to pointer function)

2018-12-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/77703
	* resolve.c (get_temp_from_expr): Use the string length of
	constant character expressions.

2018-12-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/77703
	* gfortran.dg/ptr_func_assign_5.f08 : New test.

From-SVN: r267379

gcc/fortran/ChangeLog

+2018-12-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/77703
+	* resolve.c (get_temp_from_expr): Use the string length of
+	constant character expressions.
+
 2018-12-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/88328
@@ -11,7 +17,7 @@
 	* decl.c (gfc_match_data): If a component of a derived type entity
 	appears in data statement, check that does not have the allocatable
 	attribute.
- 
+
 2018-12-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/88169

gcc/fortran/resolve.c

@@ -10637,6 +10637,11 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
   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;

gcc/testsuite/ChangeLog

+2018-12-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/77703
+	* gfortran.dg/ptr_func_assign_5.f08 : New test.
+
 2018-12-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/88328

gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08

+! { 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