[Patch, fortran] PR58754 - [4.9/5 Regression] ICE on allocating character array with source

[Paul Richard Thomas]

Dear All,

This patch speaks for itself. It is by no means as comprehensive as
the work on ALLOCATE that Andre has done on 6 branch but has the
advantage for 5 branch that it is simple and steers the failing code
to the standard assignment, which should be safe.

Bootstraps and regtests on FC21/x86_64.

OK for 4.9 and 5 branches?

Cheers

Paul

2015-10-22  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/58754
    * trans-stmt.c (gfc_trans_allocate): Do not use the scalar
    character assignment if the allocate expression sis an array
    descriptor.

2015-10-22  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/58754
    * gfortran.dg/pr58754.f90: New test
-------------- next part --------------
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 229096)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5629,5635 ****
  	      tmp = gfc_copy_class_to_class (expr3, to,
  					     nelems, upoly_expr);
  	    }
! 	  else if (code->expr3->ts.type == BT_CHARACTER)
  	    {
  	      tmp = INDIRECT_REF_P (se.expr) ?
  			se.expr :
--- 5629,5636 ----
  	      tmp = gfc_copy_class_to_class (expr3, to,
  					     nelems, upoly_expr);
  	    }
! 	  else if (code->expr3->ts.type == BT_CHARACTER
! 		   && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
  	    {
  	      tmp = INDIRECT_REF_P (se.expr) ?
  			se.expr :
Index: gcc/testsuite/gfortran.dg/pr58754.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr58754.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/pr58754.f90	(working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ !
+ ! Tests the fix for PR58754
+ !
+   type :: char_type
+     character, allocatable :: chr (:)
+   end type
+   character, allocatable :: c(:)
+   type(char_type) :: d
+   character :: t(1) = ["w"]
+ 
+   allocate (c (1), source = t)
+   if (any (c .ne. t)) call abort
+   c = ["a"]
+   if (any (c .ne. ["a"])) call abort
+   deallocate (c)
+ 
+ ! Check allocatable character components, whilst we are about it.
+   allocate (d%chr (2), source = [t, char (ichar (t) + 1)])
+   if (any (d%chr .ne. ["w", "x"])) call abort
+   d%chr = ["a","b","c","d"]
+   if (any (d%chr .ne. ["a","b","c","d"])) call abort
+   deallocate (d%chr)
+ end