re PR fortran/79072 (ICE with class(*) pointer function result and character value)

2017-11-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/79072
	* trans-expr.c (trans_class_vptr_len_assignment): Set from_len
	if the temporary is unlimited polymorphic.
	* trans-stmt.c (trans_associate_var): Use the fake result decl
	to obtain the 'len' field from an explicit function result when
	in that function scope.

2017-11-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/79072
	* gfortran.dg/class_result_5.f90: New test.

From-SVN: r254966

5 files changed, 61 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5dea204..4ba7327 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2017-11-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79072
+	* trans-expr.c (trans_class_vptr_len_assignment): Set from_len
+	if the temporary is unlimited polymorphic.
+	* trans-stmt.c (trans_associate_var): Use the fake result decl
+	to obtain the 'len' field from an explicit function result when
+	in that function scope.
+
 2017-11-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/78990
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 92d37ec..2ca0ad6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -8131,6 +8131,8 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
 	    {
 	      vptr_expr = NULL;
 	      se.expr = gfc_class_vptr_get (rse->expr);
+	      if (UNLIMITED_POLY (re))
+		from_len = gfc_class_len_get (rse->expr);
 	    }
 	  else if (re->expr_type != EXPR_NULL)
 	    /* Only when rhs is non-NULL use its declared type for vptr
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index a89751b..6cf7981 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1827,6 +1827,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	  gcc_assert (!e->symtree->n.sym->ts.deferred);
 	  tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
 	}
+      else if (e->symtree->n.sym->attr.function
+	       && e->symtree->n.sym == e->symtree->n.sym->result
+	       && e->symtree->n.sym == e->symtree->n.sym->ns->proc_name)
+	{
+	  tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0);
+	  tmp = gfc_class_len_get (tmp);
+	}
       else
 	tmp = gfc_class_len_get (gfc_get_symbol_decl (e->symtree->n.sym));
       gfc_get_symbol_decl (sym);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c8f4f49..949eb19 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/79072
+	* gfortran.dg/class_result_5.f90: New test.
+
 2017-11-20  Jakub Jelinek  <jakub@redhat.com>
 
 	P0329R4: Designated Initialization
diff --git a/gcc/testsuite/gfortran.dg/class_result_5.f90 b/gcc/testsuite/gfortran.dg/class_result_5.f90
new file mode 100644
index 0000000..c557ed3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_result_5.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+!
+! Test the fix for PR79072. The original problem was that an ICE
+! would occur in the select type construct. On fixing that, it was
+! found that the string length was not being transferred in the
+! pointer assignment in the main program.
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+function foo(string)
+  class(*), pointer :: foo
+  character(3), target :: string
+  foo => string
+  select type (foo)
+    type is (character(*))
+      if (foo .ne. 'foo') call abort
+      foo = 'bar'
+  end select
+end function
+
+  interface
+    function foo(string)
+      class(*), pointer :: foo
+      character(3), target :: string
+    end function
+  end interface
+
+  class(*), pointer :: res
+  character(3), target :: string = 'foo'
+
+  res => foo (string)
+
+  select type (res)
+    type is (character(*))
+      if (res .ne. 'bar') call abort
+  end select
+  if (string .ne. 'bar') call abort
+end