re PR fortran/71880 (pointer to allocatable character)

2018-10-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/71880
	* trans-expr.c (gfc_trans_pointer_assignment): Set the string
	length for array valued deferred length lhs.

2018-10-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/71880
	* gfortran.dg/deferred_character_31.f90 : New test.

From-SVN: r265353

gcc/fortran/ChangeLog

+2018-10-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/71880
+	* trans-expr.c (gfc_trans_pointer_assignment): Set the string
+	length for array valued deferred length lhs.
+
 2018-10-18  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/87625

gcc/fortran/trans-expr.c

@@ -8870,6 +8870,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 				   msg, rsize, lsize);
 	}
 
+      if (expr1->ts.type == BT_CHARACTER
+	  && expr1->symtree->n.sym->ts.deferred
+	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
+	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
+	{
+	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
+	  if (expr2->expr_type != EXPR_NULL)
+	    gfc_add_modify (&block, tmp,
+			    fold_convert (TREE_TYPE (tmp), strlen_rhs));
+	  else
+	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
+	}
+
       gfc_add_block_to_block (&block, &lse.post);
       if (rank_remap)
 	gfc_add_block_to_block (&block, &rse.post);

gcc/testsuite/ChangeLog

+2018-10-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/71880
+	* gfortran.dg/deferred_character_31.f90 : New test.
+
 2018-10-21  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR target/72782

gcc/testsuite/gfortran.dg/deferred_character_31.f90

+! { dg-do }
+!
+! Test the fix for PR71880 in which the string length for 'p'
+! was not set for the pointer assignment.
+!
+! Contributed by Valery Weber  <valeryweber@hotmail.com>
+!
+program t
+  character(:), dimension(:), allocatable, target :: c
+  character(:), dimension(:), pointer :: p => NULL ()
+  allocate(c, source = ['ABC','DEF','GHI'])
+  p => c
+  if (len(p) .ne. len (c)) stop 1
+  if (size (p, 1) .ne. size (c, 1)) stop 2
+  if (any (p .ne. c)) stop 3
+end program t