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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d351d50790c8e944352b33a25069a61f8502de11..a952a8f494883f76ac91234e36876e91bbcd61d6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9ce01c7dd4280a89628f04f0b0dbfd23278cc70d..ec8070ffc8daf865cb98b07bac9393d62ad4b6ce 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 806b141de78d8036a1b28898f92cab219fad59e4..a469ec9e689fdd27d3675c2f0e90ede708c64877 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 b/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08
new file mode 100644 (file)
index 0000000..9aa19e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08
@@ -0,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  <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