re PR fortran/36319 (Segfault with wide characters in DATA)

	PR fortran/36319

	* intrinsic.c (gfc_convert_chartype): Don't mark conversion
	function as pure.
	* trans-array.c (gfc_trans_array_ctor_element): Divide element
	size by the size of one character to obtain length.
	* iresolve.c (gfc_resolve_cshift): Call the _char4 variant when
	appropriate.
	(gfc_resolve_eoshift): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Minor beautification.
	(gfc_conv_intrinsic_fdate): Minor beautification.
	(gfc_conv_intrinsic_ttynam): Minor beautification.
	(gfc_conv_intrinsic_minmax_char): Allow all character kinds.
	(size_of_string_in_bytes): New function.
	(gfc_conv_intrinsic_size): Call size_of_string_in_bytes for
	character expressions.
	(gfc_conv_intrinsic_sizeof): Likewise.
	(gfc_conv_intrinsic_array_transfer): Likewise.
	(gfc_conv_intrinsic_trim): Allow all character kinds. Minor
	beautification.
	(gfc_conv_intrinsic_repeat): Fix comment typo.
	* simplify.c (gfc_convert_char_constant): Take care of conversion
	of array constructors.

	* intrinsics/string_intrinsics_inc.c (string_index): Return
	correct value for zero-length substring.
	* intrinsics/cshift0.c: Add _char4 variant.
	* intrinsics/eoshift0.c (eoshift0): Allow filler to be a pattern
	wider than a single byte. Add _char4 variant and use above
	functionality.
	* intrinsics/eoshift2.c (eoshift2): Likewise.
	* m4/eoshift1.m4: Likewise.
	* m4/eoshift3.m4: Likewise.
	* m4/cshift1.m4: Add _char4 variants.
	* gfortran.map (GFORTRAN_1.1): Add _gfortran_cshift0_1_char4,
	_gfortran_cshift0_2_char4, _gfortran_cshift0_4_char4,
	_gfortran_cshift0_8_char4, _gfortran_cshift1_16_char4,
	_gfortran_cshift1_4_char4, _gfortran_cshift1_8_char4,
	_gfortran_eoshift0_1_char4, _gfortran_eoshift0_2_char4,
	_gfortran_eoshift0_4_char4, _gfortran_eoshift0_8_char4,
	_gfortran_eoshift1_16_char4, _gfortran_eoshift1_4_char4,
	_gfortran_eoshift1_8_char4, _gfortran_eoshift2_1_char4,
	_gfortran_eoshift2_2_char4, _gfortran_eoshift2_4_char4,
	_gfortran_eoshift2_8_char4, _gfortran_eoshift3_16_char4,
	_gfortran_eoshift3_4_char4 and _gfortran_eoshift3_8_char4.
	* generated/eoshift3_4.c: Regenerate.
	* generated/eoshift1_8.c: Regenerate.
	* generated/eoshift1_16.c: Regenerate.
	* generated/cshift1_4.c: Regenerate.
	* generated/eoshift1_4.c: Regenerate.
	* generated/eoshift3_8.c: Regenerate.
	* generated/eoshift3_16.c: Regenerate.
	* generated/cshift1_8.c: Regenerate.
	* generated/cshift1_16.c: Regenerate.

	* gfortran.dg/widechar_5.f90: New file.
	* gfortran.dg/widechar_6.f90: New file.
	* gfortran.dg/widechar_7.f90: New file.
	* gfortran.dg/widechar_intrinsics_5.f90: Uncomment the lines
	testing the SPREAD intrinsic.
	* gfortran.dg/widechar_intrinsics_6.f90: New file.
	* gfortran.dg/widechar_intrinsics_7.f90: New file.
	* gfortran.dg/widechar_intrinsics_8.f90: New file.
	* gfortran.dg/widechar_intrinsics_9.f90: New file.
	* gfortran.dg/widechar_intrinsics_10.f90: New file.

From-SVN: r136129

1 files changed, 69 insertions, 20 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8c1c6b3..59b425f 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4811,26 +4811,75 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind)
   if (!gfc_is_constant_expr (e))
     return NULL;
 
-  result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
-  if (result == NULL)
-    return &gfc_bad_expr;
-
-  result->value.character.length = e->value.character.length;
-  result->value.character.string
-    = gfc_get_wide_string (e->value.character.length + 1);
-  memcpy (result->value.character.string, e->value.character.string,
-	  (e->value.character.length + 1) * sizeof (gfc_char_t));
-
-  /* Check we only have values representable in the destination kind.  */
-  for (i = 0; i < result->value.character.length; i++)
-    if (!gfc_check_character_range (result->value.character.string[i], kind))
-      {
-	gfc_error ("Character '%s' in string at %L cannot be converted into "
-		   "character kind %d",
-		   gfc_print_wide_char (result->value.character.string[i]),
-		   &e->where, kind);
+  if (e->expr_type == EXPR_CONSTANT)
+    {
+      /* Simple case of a scalar.  */
+      result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
+      if (result == NULL)
 	return &gfc_bad_expr;
-      }
 
-  return result;
+      result->value.character.length = e->value.character.length;
+      result->value.character.string
+	= gfc_get_wide_string (e->value.character.length + 1);
+      memcpy (result->value.character.string, e->value.character.string,
+	      (e->value.character.length + 1) * sizeof (gfc_char_t));
+
+      /* Check we only have values representable in the destination kind.  */
+      for (i = 0; i < result->value.character.length; i++)
+	if (!gfc_check_character_range (result->value.character.string[i],
+					kind))
+	  {
+	    gfc_error ("Character '%s' in string at %L cannot be converted "
+		       "into character kind %d",
+		       gfc_print_wide_char (result->value.character.string[i]),
+		       &e->where, kind);
+	    return &gfc_bad_expr;
+	  }
+
+      return result;
+    }
+  else if (e->expr_type == EXPR_ARRAY)
+    {
+      /* For an array constructor, we convert each constructor element.  */
+      gfc_constructor *head = NULL, *tail = NULL, *c;
+
+      for (c = e->value.constructor; c; c = c->next)
+	{
+	  if (head == NULL)
+	    head = tail = gfc_get_constructor ();
+	  else
+	    {
+	      tail->next = gfc_get_constructor ();
+	      tail = tail->next;
+	    }
+
+	  tail->where = c->where;
+	  tail->expr = gfc_convert_char_constant (c->expr, type, kind);
+	  if (tail->expr == &gfc_bad_expr)
+	    {
+	      tail->expr = NULL;
+	      return &gfc_bad_expr;
+	    }
+
+	  if (tail->expr == NULL)
+	    {
+	      gfc_free_constructor (head);
+	      return NULL;
+	    }
+	}
+
+      result = gfc_get_expr ();
+      result->ts.type = type;
+      result->ts.kind = kind;
+      result->expr_type = EXPR_ARRAY;
+      result->value.constructor = head;
+      result->shape = gfc_copy_shape (e->shape, e->rank);
+      result->where = e->where;
+      result->rank = e->rank;
+      result->ts.cl = e->ts.cl;
+
+      return result;
+    }
+  else
+    return NULL;
 }