re PR fortran/34537 (ICE or wrong code for TRANSFER of constant string to character)

2008-01-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34537
	* simplify.c (gfc_simplify_transfer): Return NULL if the size
	of the element is unavailable and only assign character length
	to the result, if 'mold' is constant.

2008-01-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34537
	* gfortran.dg/transfer_simplify_8.f90: New test.

From-SVN: r131470

gcc/fortran/ChangeLog

+2008-01-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34537
+	* simplify.c (gfc_simplify_transfer): Return NULL if the size
+	of the element is unavailable and only assign character length
+	to the result, if 'mold' is constant.
+
 2008-01-10  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/34396

gcc/fortran/simplify.c

@@ -4121,11 +4121,17 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   /* Set result character length, if needed.  Note that this needs to be
      set even for array expressions, in order to pass this information into 
      gfc_target_interpret_expr.  */
-  if (result->ts.type == BT_CHARACTER)
+  if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element))
     result->value.character.length = mold_element->value.character.length;
   
   /* Set the number of elements in the result, and determine its size.  */
   result_elt_size = gfc_target_expr_size (mold_element);
+  if (result_elt_size == 0)
+    {
+      gfc_free_expr (result);
+      return NULL;
+    }
+
   if (mold->expr_type == EXPR_ARRAY || mold->rank || size)
     {
       int result_length;

gcc/testsuite/ChangeLog

+2008-01-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34537
+	* gfortran.dg/transfer_simplify_8.f90: New test.
+
 2008-01-11  Andreas Krebbel  <krebbel1@de.ibm.com>
 
 	* g++.dg/torture/pr34641.C: Add dg-require-visibility.  Define

gcc/testsuite/gfortran.dg/transfer_simplify_8.f90

+! { dg-do run }
+! { dg-options "-O0" }
+! PR fortran/34537
+! simplify_transfer used to ICE on divide by zero for cases like this,
+! where the mold expression is a non-constant character expression.
+!
+! Testcase contributed by Tobias Burnus <burnus@gcc.gnu.org >
+!
+  character, pointer :: ptr(:)
+  character(8) :: a
+  allocate(ptr(9))
+  ptr = transfer('Sample#0'//achar(0),ptr) ! Causes ICE
+  if (any (ptr .ne. ['S','a','m','p','l','e','#','0',achar(0)])) call abort
+  call test(a)
+  if (a .ne. 'Sample#2') call abort
+contains
+  subroutine test(a)
+    character(len=*) :: a
+    a = transfer('Sample#2',a)
+  end subroutine test
+end