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

34 files changed, 1339 insertions, 112 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d879a4c..1995f6a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	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.
+
 2008-05-27  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/36316
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index e902f69..62ee442 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3807,7 +3807,6 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   new->symtree->n.sym->attr.function = 1;
   new->symtree->n.sym->attr.elemental = 1;
-  new->symtree->n.sym->attr.pure = 1;
   new->symtree->n.sym->attr.referenced = 1;
   gfc_intrinsic_symbol(new->symtree->n.sym);
   gfc_commit_symbol (new->symtree->n.sym);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 94ed4a6..acbf5be 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -627,9 +627,19 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
         }
     }
 
-  f->value.function.name
-    = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind,
-		      array->ts.type == BT_CHARACTER ? "_char" : "");
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("cshift%d_%d_char"), n, shift->ts.kind);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("cshift%d_%d_char%d"), n, shift->ts.kind,
+			    array->ts.kind);
+    }
+  else
+    f->value.function.name
+	= gfc_get_string (PREFIX ("cshift%d_%d"), n, shift->ts.kind);
 }
 
 
@@ -768,9 +778,19 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
         }
     }
 
-  f->value.function.name
-    = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind,
-		      array->ts.type == BT_CHARACTER ? "_char" : "");
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("eoshift%d_%d_char"), n, shift->ts.kind);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("eoshift%d_%d_char%d"), n, shift->ts.kind,
+			    array->ts.kind);
+    }
+  else
+    f->value.function.name
+	= gfc_get_string (PREFIX ("eoshift%d_%d"), n, shift->ts.kind);
 }
 
 
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;
 }
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index bc6d13a..7df192c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -969,7 +969,6 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 			      tree offset, gfc_se * se, gfc_expr * expr)
 {
   tree tmp;
-  tree esize;
 
   gfc_conv_expr (se, expr);
 
@@ -977,11 +976,17 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
   tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc));
   tmp = gfc_build_array_ref (tmp, offset, NULL);
 
-  esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
-  esize = fold_convert (gfc_charlen_type_node, esize);
-
   if (expr->ts.type == BT_CHARACTER)
     {
+      int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
+      tree esize;
+
+      esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+      esize = fold_convert (gfc_charlen_type_node, esize);
+      esize = fold_build2 (TRUNC_DIV_EXPR, gfc_charlen_type_node, esize,
+			   build_int_cst (gfc_charlen_type_node,
+					  gfc_character_kinds[i].bit_size / 8));
+
       gfc_conv_string_parameter (se);
       if (POINTER_TYPE_P (TREE_TYPE (tmp)))
 	{
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 990a127..73e14a3 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1327,9 +1327,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
   tree var;
   tree len;
   tree tmp;
-  tree type;
   tree cond;
-  tree gfc_int8_type_node = gfc_get_int_type (8);
   tree fndecl;
   tree *args;
   unsigned int num_args;
@@ -1337,9 +1335,8 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
   num_args = gfc_intrinsic_argument_list_length (expr) + 2;
   args = alloca (sizeof (tree) * num_args);
 
-  type = build_pointer_type (gfc_character1_type_node);
-  var = gfc_create_var (type, "pstr");
-  len = gfc_create_var (gfc_int8_type_node, "len");
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_get_int_type (8), "len");
 
   gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
   args[0] = build_fold_addr_expr (var);
@@ -1368,9 +1365,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
   tree var;
   tree len;
   tree tmp;
-  tree type;
   tree cond;
-  tree gfc_int4_type_node = gfc_get_int_type (4);
   tree fndecl;
   tree *args;
   unsigned int num_args;
@@ -1378,9 +1373,8 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
   num_args = gfc_intrinsic_argument_list_length (expr) + 2;
   args = alloca (sizeof (tree) * num_args);
 
-  type = build_pointer_type (gfc_character1_type_node);
-  var = gfc_create_var (type, "pstr");
-  len = gfc_create_var (gfc_int4_type_node, "len");
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_get_int_type (4), "len");
 
   gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
   args[0] = build_fold_addr_expr (var);
@@ -1411,19 +1405,16 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
   tree var;
   tree len;
   tree tmp;
-  tree type;
   tree cond;
   tree fndecl;
-  tree gfc_int4_type_node = gfc_get_int_type (4);
   tree *args;
   unsigned int num_args;
 
   num_args = gfc_intrinsic_argument_list_length (expr) + 2;
   args = alloca (sizeof (tree) * num_args);
 
-  type = build_pointer_type (gfc_character1_type_node);
-  var = gfc_create_var (type, "pstr");
-  len = gfc_create_var (gfc_int4_type_node, "len");
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_get_int_type (4), "len");
 
   gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
   args[0] = build_fold_addr_expr (var);
@@ -1551,7 +1542,7 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
   /* Create the result variables.  */
   len = gfc_create_var (gfc_charlen_type_node, "len");
   args[0] = build_fold_addr_expr (len);
-  var = gfc_create_var (build_pointer_type (gfc_character1_type_node), "pstr");
+  var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr");
   args[1] = gfc_build_addr_expr (ppvoid_type_node, var);
   args[2] = build_int_cst (NULL_TREE, op);
   args[3] = build_int_cst (NULL_TREE, nargs / 2);
@@ -3237,6 +3228,24 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* Helper function to compute the size of a character variable,
+   excluding the terminating null characters.  The result has
+   gfc_array_index_type type.  */
+
+static tree
+size_of_string_in_bytes (int kind, tree string_length)
+{
+  tree bytesize;
+  int i = gfc_validate_kind (BT_CHARACTER, kind, false);
+ 
+  bytesize = build_int_cst (gfc_array_index_type,
+			    gfc_character_kinds[i].bit_size / 8);
+
+  return fold_build2 (MULT_EXPR, gfc_array_index_type, bytesize,
+		      fold_convert (gfc_array_index_type, string_length));
+}
+
+
 static void
 gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
 {
@@ -3249,7 +3258,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
   tree tmp;
   tree lower;
   tree upper;
-  /*tree stride;*/
   int n;
 
   arg = expr->value.function.actual->expr;
@@ -3268,8 +3276,8 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
 
       /* Obtain the source word length.  */
       if (arg->ts.type == BT_CHARACTER)
-	source_bytes = fold_convert (gfc_array_index_type,
-				     argse.string_length);
+	source_bytes = size_of_string_in_bytes (arg->ts.kind,
+						argse.string_length);
       else
 	source_bytes = fold_convert (gfc_array_index_type,
 				     size_in_bytes (type)); 
@@ -3283,7 +3291,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
 
       /* Obtain the argument's word length.  */
       if (arg->ts.type == BT_CHARACTER)
-	tmp = fold_convert (gfc_array_index_type, argse.string_length);
+	tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length);
       else
 	tmp = fold_convert (gfc_array_index_type,
 			    size_in_bytes (type)); 
@@ -3404,7 +3412,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 
       /* Obtain the source word length.  */
       if (arg->expr->ts.type == BT_CHARACTER)
-	tmp = fold_convert (gfc_array_index_type, argse.string_length);
+	tmp = size_of_string_in_bytes (arg->expr->ts.kind,
+				       argse.string_length);
       else
 	tmp = fold_convert (gfc_array_index_type,
 			    size_in_bytes (source_type)); 
@@ -3443,7 +3452,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 
       /* Obtain the source word length.  */
       if (arg->expr->ts.type == BT_CHARACTER)
-	tmp = fold_convert (gfc_array_index_type, argse.string_length);
+	tmp = size_of_string_in_bytes (arg->expr->ts.kind,
+				       argse.string_length);
       else
 	tmp = fold_convert (gfc_array_index_type,
 			    size_in_bytes (source_type)); 
@@ -3495,7 +3505,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 
   if (arg->expr->ts.type == BT_CHARACTER)
     {
-      tmp = fold_convert (gfc_array_index_type, argse.string_length);
+      tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length);
       mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp);
     }
   else
@@ -3869,12 +3879,10 @@ gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr)
 static void
 gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
 {
-  tree gfc_int4_type_node = gfc_get_int_type (4);
   tree var;
   tree len;
   tree addr;
   tree tmp;
-  tree type;
   tree cond;
   tree fndecl;
   tree function;
@@ -3884,10 +3892,9 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
   num_args = gfc_intrinsic_argument_list_length (expr) + 2;
   args = alloca (sizeof (tree) * num_args);
 
-  type = build_pointer_type (gfc_character1_type_node);
-  var = gfc_create_var (type, "pstr");
+  var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr");
   addr = gfc_build_addr_expr (ppvoid_type_node, var);
-  len = gfc_create_var (gfc_int4_type_node, "len");
+  len = gfc_create_var (gfc_get_int_type (4), "len");
 
   gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
   args[0] = build_fold_addr_expr (len);
@@ -3928,7 +3935,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
   stmtblock_t block, body;
   int i;
 
-  /* We store in charsize the size of an character.  */
+  /* We store in charsize the size of a character.  */
   i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
   size = build_int_cst (size_type_node, gfc_character_kinds[i].bit_size / 8);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b715c2d..1a33d2e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,17 @@
+2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36319
+	* 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.
+
 2008-05-28  Seongbae Park <seongbae.park@gmail.com>
 
 	* gcc.dg/tree-prof/ic-misattribution-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/widechar_5.f90 b/gcc/testsuite/gfortran.dg/widechar_5.f90
new file mode 100644
index 0000000..ed2f32f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_5.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+module kinds
+  implicit none
+  integer, parameter :: one = 1, four = 4
+end module kinds
+
+module inner
+  use kinds
+  implicit none
+  character(kind=one,len=*), parameter :: inner1 = "abcdefg \xEF kl"
+  character(kind=four,len=*), parameter :: &
+        inner4 = 4_"\u9317x \U001298cef   dea\u10De"
+end module inner
+
+module middle
+  use inner
+  implicit none
+  character(kind=one,len=len(inner1)), dimension(2,2), parameter :: middle1 &
+    = reshape ([ character(kind=one,len=len(inner1)) :: inner1, ""], &
+               [ 2, 2 ], &
+               [ character(kind=one,len=len(inner1)) :: "foo", "ba " ])
+  character(kind=four,len=len(inner4)), dimension(2,2), parameter :: middle4 &
+    = reshape ([ character(kind=four,len=len(inner4)) :: inner4, 4_""], &
+               [ 2, 2 ], &
+               [ character(kind=four,len=len(inner4)) :: 4_"foo", 4_"ba " ])
+end module middle
+
+module outer
+  use middle
+  implicit none
+  character(kind=one,len=*), parameter :: my1(2) = middle1(1,:)
+  character(kind=four,len=*), parameter :: my4(2) = middle4(1,:)
+end module outer
+
+program test_modules
+  use outer, outer1 => my1, outer4 => my4
+  implicit none
+
+  if (len (inner1) /= len(inner4)) call abort
+  if (len (inner1) /= len_trim(inner1)) call abort
+  if (len (inner4) /= len_trim(inner4)) call abort
+
+  if (len(middle1) /= len(inner1)) call abort
+  if (len(outer1) /= len(inner1)) call abort
+  if (len(middle4) /= len(inner4)) call abort
+  if (len(outer4) /= len(inner4)) call abort
+
+  if (any (len_trim (middle1) /= reshape([len(middle1), 0, 3, 2], [2,2]))) &
+    call abort
+  if (any (len_trim (middle4) /= reshape([len(middle4), 0, 3, 2], [2,2]))) &
+    call abort
+  if (any (len_trim (outer1) /= [len(outer1), 3])) call abort
+  if (any (len_trim (outer4) /= [len(outer4), 3])) call abort
+
+end program test_modules
+
+! { dg-final { cleanup-modules "kinds inner middle outer" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_6.f90 b/gcc/testsuite/gfortran.dg/widechar_6.f90
new file mode 100644
index 0000000..9151adb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_6.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+
+module mod
+
+  interface cut
+    module procedure cut1
+    module procedure cut4
+  end interface cut
+
+contains
+
+  function cut1 (s)
+    character(kind=1,len=*), intent(in) :: s
+    character(kind=1,len=max(0,len(s)-3)) :: cut1
+
+    cut1 = s(4:)
+  end function cut1
+
+  function cut4 (s)
+    character(kind=4,len=*), intent(in) :: s
+    character(kind=4,len=max(0,len(s)-3)) :: cut4
+
+    cut4 = s(4:)
+  end function cut4
+
+end module mod
+
+program test
+  use mod
+
+  if (len (cut1("")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("1")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("12")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("123")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("1234")) /= 1 .or. cut1("4") /= "") call abort
+  if (len (cut1("12345")) /= 2 .or. cut1("45") /= "") call abort
+
+  if (len (cut4(4_"")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"1")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"12")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"123")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"1234")) /= 1 .or. cut4(4_"4") /= 4_"") call abort
+  if (len (cut4(4_"12345")) /= 2 .or. cut4(4_"45") /= 4_"") call abort
+
+  if (kind (cut("")) /= kind("")) call abort
+  if (kind (cut(4_"")) /= kind(4_"")) call abort
+
+  if (len (cut("")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("1")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("12")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("123")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("1234")) /= 1 .or. cut("4") /= "") call abort
+  if (len (cut("12345")) /= 2 .or. cut("45") /= "") call abort
+
+  if (len (cut(4_"")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"1")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"12")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"123")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"1234")) /= 1 .or. cut(4_"4") /= 4_"") call abort
+  if (len (cut(4_"12345")) /= 2 .or. cut(4_"45") /= 4_"") call abort
+
+end program test
+
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_7.f90 b/gcc/testsuite/gfortran.dg/widechar_7.f90
new file mode 100644
index 0000000..4368321
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_7.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+
+program test
+
+  character(kind=1,len=10) :: s1 = 4_"foobargee", t1 = 4_""
+  character(kind=4,len=10) :: s4 = "foobargee", t4 = ""
+
+  t1(5:5) = s1(6:6)
+  t4(5:5) = s4(6:6)
+  t4(5:5) = s1(6:6)
+  t1(5:5) = s4(6:6)
+
+  call sub (t1, t4)
+
+end program test
+
+! { dg-final { scan-tree-dump-times "memmove" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90
new file mode 100644
index 0000000..c961d93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90
@@ -0,0 +1,89 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  implicit none
+  character(kind=1,len=3) :: s1(3)
+  character(kind=4,len=3) :: s4(3)
+
+  s1 = [ "abc", "def", "ghi" ]
+  s4 = s1
+  s4 = [ "abc", "def", "ghi" ]
+
+  if (any (cshift (s1, 0) /= s1)) call abort
+  if (any (cshift (s4, 0) /= s4)) call abort
+  if (any (cshift (s1, 3) /= s1)) call abort
+  if (any (cshift (s4, 3) /= s4)) call abort
+  if (any (cshift (s1, 6) /= s1)) call abort
+  if (any (cshift (s4, 6) /= s4)) call abort
+  if (any (cshift (s1, -3) /= s1)) call abort
+  if (any (cshift (s4, -3) /= s4)) call abort
+  if (any (cshift (s1, -6) /= s1)) call abort
+  if (any (cshift (s4, -6) /= s4)) call abort
+
+  if (any (cshift (s1, 1) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, -1) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, 4) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, -4) /= [ s1(3), s1(1:2) ])) call abort
+
+  if (any (cshift (s4, 1) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, -1) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, 4) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, -4) /= [ s4(3), s4(1:2) ])) call abort
+
+  if (any (cshift (s1, 2) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, -2) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, 5) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, -5) /= [ s1(2:3), s1(1) ])) call abort
+
+  if (any (cshift (s4, 2) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, -2) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, 5) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, -5) /= [ s4(2:3), s4(1) ])) call abort
+
+
+  if (any (eoshift (s1, 0) /= s1)) call abort
+  if (any (eoshift (s4, 0) /= s4)) call abort
+  if (any (eoshift (s1, 3) /= "")) call abort
+  if (any (eoshift (s4, 3) /= 4_"")) call abort
+  if (any (eoshift (s1, 3, "   ") /= "")) call abort
+  if (any (eoshift (s4, 3, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, 3, " x ") /= " x")) call abort
+  if (any (eoshift (s4, 3, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, -3) /= "")) call abort
+  if (any (eoshift (s4, -3) /= 4_"")) call abort
+  if (any (eoshift (s1, -3, "   ") /= "")) call abort
+  if (any (eoshift (s4, -3, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, -3, " x ") /= " x")) call abort
+  if (any (eoshift (s4, -3, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, 4) /= "")) call abort
+  if (any (eoshift (s4, 4) /= 4_"")) call abort
+  if (any (eoshift (s1, 4, "   ") /= "")) call abort
+  if (any (eoshift (s4, 4, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, 4, " x ") /= " x")) call abort
+  if (any (eoshift (s4, 4, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, -4) /= "")) call abort
+  if (any (eoshift (s4, -4) /= 4_"")) call abort
+  if (any (eoshift (s1, -4, "   ") /= "")) call abort
+  if (any (eoshift (s4, -4, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, -4, " x ") /= " x")) call abort
+  if (any (eoshift (s4, -4, 4_" x ") /= 4_" x")) call abort
+
+  if (any (eoshift (s1, 1) /= [ s1(2:3), "   " ])) call abort
+  if (any (eoshift (s1, -1) /= [ "   ", s1(1:2) ])) call abort
+  if (any (eoshift (s1, 1, " x ") /= [ s1(2:3), " x " ])) call abort
+  if (any (eoshift (s1, -1, " x ") /= [ " x ", s1(1:2) ])) call abort
+  if (any (eoshift (s4, 1) /= [ s4(2:3), 4_"   " ])) call abort
+  if (any (eoshift (s4, -1) /= [ 4_"   ", s4(1:2) ])) call abort
+  if (any (eoshift (s4, 1, 4_" x ") /= [ s4(2:3), 4_" x " ])) call abort
+  if (any (eoshift (s4, -1, 4_" x ") /= [ 4_" x ", s4(1:2) ])) call abort
+
+  if (any (eoshift (s1, 2) /= [ s1(3), "   ", "   " ])) call abort
+  if (any (eoshift (s1, -2) /= [ "   ", "   ", s1(1) ])) call abort
+  if (any (eoshift (s1, 2, " x ") /= [ s1(3), " x ", " x " ])) call abort
+  if (any (eoshift (s1, -2, " x ") /= [ " x ", " x ", s1(1) ])) call abort
+  if (any (eoshift (s4, 2) /= [ s4(3), 4_"   ", 4_"   " ])) call abort
+  if (any (eoshift (s4, -2) /= [ 4_"   ", 4_"   ", s4(1) ])) call abort
+  if (any (eoshift (s4, 2, 4_" x ") /= [ s4(3), 4_" x ", 4_" x " ])) call abort
+  if (any (eoshift (s4, -2, 4_" x ") /= [ 4_" x ", 4_" x ", s4(1) ])) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90
index 5c989cc..e388685 100644
--- a/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90
@@ -70,15 +70,13 @@
   if (any(transpose(m2) /= transpose(m1))) call abort
   deallocate (m2)
 
-  ! Tests below should be uncommented when PR36257 is fixed.
-  !
-  !allocate (m2(3,3))
-  !m2 = p
-  !m1 = m2
-  !if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort
-  !if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort
-  !if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort
-  !deallocate (m2)
+  allocate (m2(3,3))
+  m2 = p
+  m1 = m2
+  if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort
+  if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort
+  if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort
+  deallocate (m2)
 
   allocate (m2(3,3))
   m2 = p
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90
new file mode 100644
index 0000000..68b46d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90
@@ -0,0 +1,109 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1, len=3) :: s1
+  character(kind=4, len=3) :: s4
+  integer :: i
+
+  s1 = "fo "
+  s4 = 4_"fo "
+  i = 3
+
+  ! Check the REPEAT intrinsic
+
+  if (repeat (1_"foo", 2) /= 1_"foofoo") call abort
+  if (repeat (1_"fo ", 2) /= 1_"fo fo ") call abort
+  if (repeat (1_"fo ", 2) /= 1_"fo fo") call abort
+  if (repeat (1_"fo ", 0) /= 1_"") call abort
+  if (repeat (s1, 2) /= 1_"fo fo ") call abort
+  if (repeat (s1, 2) /= 1_"fo fo") call abort
+  if (repeat (s1, 2) /= s1 // s1) call abort
+  if (repeat (s1, 3) /= s1 // s1 // s1) call abort
+  if (repeat (s1, 1) /= s1) call abort
+  if (repeat (s1, 0) /= "") call abort
+
+  if (repeat (4_"foo", 2) /= 4_"foofoo") call abort
+  if (repeat (4_"fo ", 2) /= 4_"fo fo ") call abort
+  if (repeat (4_"fo ", 2) /= 4_"fo fo") call abort
+  if (repeat (4_"fo ", 0) /= 4_"") call abort
+  if (repeat (s4, 2) /= 4_"fo fo ") call abort
+  if (repeat (s4, 2) /= 4_"fo fo") call abort
+  if (repeat (s4, 3) /= s4 // s4 // s4) call abort
+  if (repeat (s4, 1) /= s4) call abort
+  if (repeat (s4, 0) /= 4_"") call abort
+
+  call check_repeat (s1, s4)
+  call check_repeat ("", 4_"")
+  call check_repeat ("truc", 4_"truc")
+  call check_repeat ("truc ", 4_"truc ")
+
+  ! Check NEW_LINE
+
+  if (ichar(new_line ("")) /= 10) call abort
+  if (len(new_line ("")) /= 1) call abort
+  if (ichar(new_line (s1)) /= 10) call abort
+  if (len(new_line (s1)) /= 1) call abort
+  if (ichar(new_line (["",""])) /= 10) call abort
+  if (len(new_line (["",""])) /= 1) call abort
+  if (ichar(new_line ([s1,s1])) /= 10) call abort
+  if (len(new_line ([s1,s1])) /= 1) call abort
+
+  if (ichar(new_line (4_"")) /= 10) call abort
+  if (len(new_line (4_"")) /= 1) call abort
+  if (ichar(new_line (s4)) /= 10) call abort
+  if (len(new_line (s4)) /= 1) call abort
+  if (ichar(new_line ([4_"",4_""])) /= 10) call abort
+  if (len(new_line ([4_"",4_""])) /= 1) call abort
+  if (ichar(new_line ([s4,s4])) /= 10) call abort
+  if (len(new_line ([s4,s4])) /= 1) call abort
+
+  ! Check SIZEOF
+
+  if (sizeof ("") /= 0) call abort
+  if (sizeof (4_"") /= 0) call abort
+  if (sizeof ("x") /= 1) call abort
+  if (sizeof ("\xFF") /= 1) call abort
+  if (sizeof (4_"x") /= 4) call abort
+  if (sizeof (4_"\UFFFFFFFF") /= 4) call abort
+  if (sizeof (s1) /= 3) call abort
+  if (sizeof (s4) /= 12) call abort
+
+  if (sizeof (["a", "x", "z"]) / sizeof ("a") /= 3) call abort
+  if (sizeof ([4_"a", 4_"x", 4_"z"]) / sizeof (4_"a") /= 3) call abort
+
+  call check_sizeof ("", 4_"", 0)
+  call check_sizeof ("x", 4_"x", 1)
+  call check_sizeof ("\xFF", 4_"\UFEBCE19E", 1)
+  call check_sizeof ("\xFF ", 4_"\UFEBCE19E ", 2)
+  call check_sizeof (s1, s4, 3)
+
+contains
+
+  subroutine check_repeat (s1, s4)
+    character(kind=1, len=*), intent(in) :: s1
+    character(kind=4, len=*), intent(in) :: s4
+    integer :: i
+
+    do i = 0, 10
+      if (len (repeat(s1, i)) /= i * len(s1)) call abort
+      if (len (repeat(s4, i)) /= i * len(s4)) call abort
+
+      if (len_trim (repeat(s1, i)) &
+          /= max(0, (i - 1) * len(s1) + len_trim (s1))) call abort
+      if (len_trim (repeat(s4, i)) &
+          /= max(0, (i - 1) * len(s4) + len_trim (s4))) call abort
+    end do
+  end subroutine check_repeat
+
+  subroutine check_sizeof (s1, s4, i)
+    character(kind=1, len=*), intent(in) :: s1
+    character(kind=4, len=*), intent(in) :: s4
+    character(kind=4, len=len(s4)) :: t4
+    integer, intent(in) :: i
+    
+    if (sizeof (s1) /= i) call abort
+    if (sizeof (s4) / sizeof (4_" ") /= i) call abort
+    if (sizeof (t4) / sizeof (4_" ") /= i) call abort
+  end subroutine check_sizeof
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90
new file mode 100644
index 0000000..7971af3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90
@@ -0,0 +1,125 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1, len=10) :: s1, t1
+  character(kind=4, len=10) :: s4, t4
+
+  call check1("foobargeefoobargee", "arg", &
+              [ index  ("foobargeefoobargee", "arg", .true.),  &
+                index  ("foobargeefoobargee", "arg", .false.), &
+                scan   ("foobargeefoobargee", "arg", .true.),  &
+                scan   ("foobargeefoobargee", "arg", .false.), &
+                verify ("foobargeefoobargee", "arg", .true.),  &
+                verify ("foobargeefoobargee", "arg", .false.) ], &
+              4_"foobargeefoobargee", 4_"arg", &
+              [ index  (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"arg", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"arg", .false.), &
+                verify (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"arg", .false.) ])
+
+  call check1("foobargeefoobargee", "", &
+              [ index  ("foobargeefoobargee", "", .true.),  &
+                index  ("foobargeefoobargee", "", .false.), &
+                scan   ("foobargeefoobargee", "", .true.),  &
+                scan   ("foobargeefoobargee", "", .false.), &
+                verify ("foobargeefoobargee", "", .true.),  &
+                verify ("foobargeefoobargee", "", .false.) ], &
+              4_"foobargeefoobargee", 4_"", &
+              [ index  (4_"foobargeefoobargee", 4_"", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"", .false.), &
+                verify (4_"foobargeefoobargee", 4_"", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"", .false.) ])
+  call check1("foobargeefoobargee", "klm", &
+              [ index  ("foobargeefoobargee", "klm", .true.),  &
+                index  ("foobargeefoobargee", "klm", .false.), &
+                scan   ("foobargeefoobargee", "klm", .true.),  &
+                scan   ("foobargeefoobargee", "klm", .false.), &
+                verify ("foobargeefoobargee", "klm", .true.),  &
+                verify ("foobargeefoobargee", "klm", .false.) ], &
+              4_"foobargeefoobargee", 4_"klm", &
+              [ index  (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"klm", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"klm", .false.), &
+                verify (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"klm", .false.) ])
+  call check1("foobargeefoobargee", "gee", &
+              [ index  ("foobargeefoobargee", "gee", .true.),  &
+                index  ("foobargeefoobargee", "gee", .false.), &
+                scan   ("foobargeefoobargee", "gee", .true.),  &
+                scan   ("foobargeefoobargee", "gee", .false.), &
+                verify ("foobargeefoobargee", "gee", .true.),  &
+                verify ("foobargeefoobargee", "gee", .false.) ], &
+              4_"foobargeefoobargee", 4_"gee", &
+              [ index  (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"gee", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"gee", .false.), &
+                verify (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"gee", .false.) ])
+  call check1("foobargeefoobargee", "foo", &
+              [ index  ("foobargeefoobargee", "foo", .true.),  &
+                index  ("foobargeefoobargee", "foo", .false.), &
+                scan   ("foobargeefoobargee", "foo", .true.),  &
+                scan   ("foobargeefoobargee", "foo", .false.), &
+                verify ("foobargeefoobargee", "foo", .true.),  &
+                verify ("foobargeefoobargee", "foo", .false.) ], &
+              4_"foobargeefoobargee", 4_"foo", &
+              [ index  (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"foo", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"foo", .false.), &
+                verify (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"foo", .false.) ])
+
+  call check1("  \b fe \b\0 bar cad", " \b\0", &
+              [ index  ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                index  ("  \b fe \b\0 bar cad", " \b\0", .false.), &
+                scan   ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                scan   ("  \b fe \b\0 bar cad", " \b\0", .false.), &
+                verify ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                verify ("  \b fe \b\0 bar cad", " \b\0", .false.) ], &
+              4_"  \uC096 fe \uC096\uB8DE bar cad", 4_" \uC096\uB8DE", &
+              [ index  (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                index  (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.), &
+                scan   (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                scan   (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.), &
+                verify (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                verify (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.) ])
+
+contains
+
+  subroutine check1 (s1, t1, res1, s4, t4, res4)
+    character(kind=1, len=*) :: s1, t1
+    character(kind=4, len=*) :: s4, t4
+    integer :: res1(6), res4(6)
+
+    if (any (res1 /= res4)) call abort
+
+    if (index  (s1, t1, .true.)  /= res1(1)) call abort
+    if (index  (s1, t1, .false.) /= res1(2)) call abort
+    if (scan   (s1, t1, .true.)  /= res1(3)) call abort
+    if (scan   (s1, t1, .false.) /= res1(4)) call abort
+    if (verify (s1, t1, .true.)  /= res1(5)) call abort
+    if (verify (s1, t1, .false.) /= res1(6)) call abort
+
+    if (index  (s4, t4, .true.)  /= res4(1)) call abort
+    if (index  (s4, t4, .false.) /= res4(2)) call abort
+    if (scan   (s4, t4, .true.)  /= res4(3)) call abort
+    if (scan   (s4, t4, .false.) /= res4(4)) call abort
+    if (verify (s4, t4, .true.)  /= res4(5)) call abort
+    if (verify (s4, t4, .false.) /= res4(6)) call abort
+
+  end subroutine check1
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90
new file mode 100644
index 0000000..eeeabbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90
@@ -0,0 +1,85 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  logical, parameter :: bigendian = transfer ((/1_1,0_1,0_1,0_1/), 0_4) /= 1
+
+  character(kind=1,len=3) :: s1, t1, u1
+  character(kind=4,len=3) :: s4, t4, u4
+
+  ! Test MERGE intrinsic
+
+  call check_merge1 ("foo", "gee", .true., .false.)
+  call check_merge4 (4_"foo", 4_"gee", .true., .false.)
+
+  if (merge ("foo", "gee", .true.) /= "foo") call abort
+  if (merge ("foo", "gee", .false.) /= "gee") call abort
+  if (merge (4_"foo", 4_"gee", .true.) /= 4_"foo") call abort
+  if (merge (4_"foo", 4_"gee", .false.) /= 4_"gee") call abort
+
+  ! Test TRANSFER intrinsic
+
+  if (bigendian) then
+    if (transfer (4_"x", "    ") /= "\0\0\0x") call abort
+  else
+    if (transfer (4_"x", "    ") /= "x\0\0\0") call abort
+  endif
+  if (transfer (4_"\U44444444", "    ") /= "\x44\x44\x44\x44") call abort
+  if (transfer (4_"\U3FE91B5A", 0_4) /= int(z'3FE91B5A', 4)) call abort
+
+  call check_transfer_i (4_"\U3FE91B5A", [int(z'3FE91B5A', 4)])
+  call check_transfer_i (4_"\u1B5A", [int(z'1B5A', 4)])
+
+contains
+
+  subroutine check_merge1 (s1, t1, t, f)
+    character(kind=1,len=*) :: s1, t1
+    logical :: t, f
+
+    if (merge (s1, t1, .true.) /= s1) call abort
+    if (merge (s1, t1, .false.) /= t1) call abort
+    if (len (merge (s1, t1, .true.)) /= len (s1)) call abort
+    if (len (merge (s1, t1, .false.)) /= len (t1)) call abort
+    if (len_trim (merge (s1, t1, .true.)) /= len_trim (s1)) call abort
+    if (len_trim (merge (s1, t1, .false.)) /= len_trim (t1)) call abort
+
+    if (merge (s1, t1, t) /= s1) call abort
+    if (merge (s1, t1, f) /= t1) call abort
+    if (len (merge (s1, t1, t)) /= len (s1)) call abort
+    if (len (merge (s1, t1, f)) /= len (t1)) call abort
+    if (len_trim (merge (s1, t1, t)) /= len_trim (s1)) call abort
+    if (len_trim (merge (s1, t1, f)) /= len_trim (t1)) call abort
+
+  end subroutine check_merge1
+
+  subroutine check_merge4 (s4, t4, t, f)
+    character(kind=4,len=*) :: s4, t4
+    logical :: t, f
+
+    if (merge (s4, t4, .true.) /= s4) call abort
+    if (merge (s4, t4, .false.) /= t4) call abort
+    if (len (merge (s4, t4, .true.)) /= len (s4)) call abort
+    if (len (merge (s4, t4, .false.)) /= len (t4)) call abort
+    if (len_trim (merge (s4, t4, .true.)) /= len_trim (s4)) call abort
+    if (len_trim (merge (s4, t4, .false.)) /= len_trim (t4)) call abort
+
+    if (merge (s4, t4, t) /= s4) call abort
+    if (merge (s4, t4, f) /= t4) call abort
+    if (len (merge (s4, t4, t)) /= len (s4)) call abort
+    if (len (merge (s4, t4, f)) /= len (t4)) call abort
+    if (len_trim (merge (s4, t4, t)) /= len_trim (s4)) call abort
+    if (len_trim (merge (s4, t4, f)) /= len_trim (t4)) call abort
+
+  end subroutine check_merge4
+
+  subroutine check_transfer_i (s, i)
+    character(kind=4,len=*) :: s
+    integer(kind=4), dimension(len(s)) :: i
+
+    if (transfer (s, 0_4) /= ichar (s(1:1))) call abort
+    if (transfer (s, 0_4) /= i(1)) call abort
+    if (any (transfer (s, [0_4]) /= i)) call abort
+    if (any (transfer (s, 0_4, len(s)) /= i)) call abort
+
+  end subroutine check_transfer_i
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90
new file mode 100644
index 0000000..ca6fa58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  implicit none
+  character(kind=1,len=3) :: s1, t1
+  character(kind=4,len=3) :: s4, t4
+
+  s1 = "foo" ; t1 = "bar"
+  call check_minmax_1 ("foo", "bar", min("foo","bar"), max("foo","bar"))
+  call check_minmax_1 ("bar", "foo", min("foo","bar"), max("foo","bar"))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "   " ; t1 = "bar"
+  call check_minmax_1 ("   ", "bar", min("   ","bar"), max("   ","bar"))
+  call check_minmax_1 ("bar", "   ", min("   ","bar"), max("   ","bar"))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "   " ; t1 = "   "
+  call check_minmax_1 ("   ", "   ", min("   ","   "), max("   ","   "))
+  call check_minmax_1 ("   ", "   ", min("   ","   "), max("   ","   "))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "d\xFF " ; t1 = "d  "
+  call check_minmax_1 ("d\xFF ", "d  ", min("d\xFF ","d  "), max("d\xFF ","d  "))
+  call check_minmax_1 ("d  ", "d\xFF ", min("d\xFF ","d  "), max("d\xFF ","d  "))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s4 = 4_"   " ; t4 = 4_"xxx"
+  call check_minmax_2 (4_"   ", 4_"xxx", min(4_"   ", 4_"xxx"), &
+                       max(4_"   ", 4_"xxx"))
+  call check_minmax_2 (4_"xxx", 4_"   ", min(4_"   ", 4_"xxx"), &
+                       max(4_"   ", 4_"xxx"))
+  call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4))
+  call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4))
+
+  s4 = 4_" \u1be3m" ; t4 = 4_"xxx"
+  call check_minmax_2 (4_" \u1be3m", 4_"xxx", min(4_" \u1be3m", 4_"xxx"), &
+                       max(4_" \u1be3m", 4_"xxx"))
+  call check_minmax_2 (4_"xxx", 4_" \u1be3m", min(4_" \u1be3m", 4_"xxx"), &
+                       max(4_" \u1be3m", 4_"xxx"))
+  call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4))
+  call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4))
+
+contains
+
+  subroutine check_minmax_1 (s1, s2, smin, smax)
+    implicit none
+    character(kind=1,len=*), intent(in) :: s1, s2, smin, smax
+    character(kind=4,len=len(s1)) :: w1, w2, wmin, wmax
+
+    w1 = s1 ; w2 = s2 ; wmin = smin ; wmax = smax
+    if (min (w1, w2) /= wmin) call abort
+    if (max (w1, w2) /= wmax) call abort
+    if (min (s1, s2) /= smin) call abort
+    if (max (s1, s2) /= smax) call abort
+  end subroutine check_minmax_1
+
+  subroutine check_minmax_2 (s1, s2, smin, smax)
+    implicit none
+    character(kind=4,len=*), intent(in) :: s1, s2, smin, smax
+
+    if (min (s1, s2) /= smin) call abort
+    if (max (s1, s2) /= smax) call abort
+  end subroutine check_minmax_2
+
+end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 877ab62..9a25ecd 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,37 @@
+2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36319
+	* 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.
+
 2008-05-25  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/32600
diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c
index a29bf79..2943c3e 100644
--- a/libgfortran/generated/cshift1_16.c
+++ b/libgfortran/generated/cshift1_16.c
@@ -212,6 +212,7 @@ cshift1_16 (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
 }
 
+
 void cshift1_16_char (gfc_array_char * const restrict ret, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict array,
@@ -231,4 +232,24 @@ cshift1_16_char (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, array_length);
 }
 
+
+void cshift1_16_char4 (gfc_array_char * const restrict ret, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict array,
+	const gfc_array_i16 * const restrict h, 
+	const GFC_INTEGER_16 * const restrict pwhich,
+	GFC_INTEGER_4);
+export_proto(cshift1_16_char4);
+
+void
+cshift1_16_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array,
+	const gfc_array_i16 * const restrict h, 
+	const GFC_INTEGER_16 * const restrict pwhich,
+	GFC_INTEGER_4 array_length)
+{
+  cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+}
+
 #endif
diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c
index 0525873..3f4f9e0b 100644
--- a/libgfortran/generated/cshift1_4.c
+++ b/libgfortran/generated/cshift1_4.c
@@ -212,6 +212,7 @@ cshift1_4 (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
 }
 
+
 void cshift1_4_char (gfc_array_char * const restrict ret, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict array,
@@ -231,4 +232,24 @@ cshift1_4_char (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, array_length);
 }
 
+
+void cshift1_4_char4 (gfc_array_char * const restrict ret, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict array,
+	const gfc_array_i4 * const restrict h, 
+	const GFC_INTEGER_4 * const restrict pwhich,
+	GFC_INTEGER_4);
+export_proto(cshift1_4_char4);
+
+void
+cshift1_4_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array,
+	const gfc_array_i4 * const restrict h, 
+	const GFC_INTEGER_4 * const restrict pwhich,
+	GFC_INTEGER_4 array_length)
+{
+  cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+}
+
 #endif
diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c
index 624b662..4d246e5 100644
--- a/libgfortran/generated/cshift1_8.c
+++ b/libgfortran/generated/cshift1_8.c
@@ -212,6 +212,7 @@ cshift1_8 (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
 }
 
+
 void cshift1_8_char (gfc_array_char * const restrict ret, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict array,
@@ -231,4 +232,24 @@ cshift1_8_char (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, array_length);
 }
 
+
+void cshift1_8_char4 (gfc_array_char * const restrict ret, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict array,
+	const gfc_array_i8 * const restrict h, 
+	const GFC_INTEGER_8 * const restrict pwhich,
+	GFC_INTEGER_4);
+export_proto(cshift1_8_char4);
+
+void
+cshift1_8_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array,
+	const gfc_array_i8 * const restrict h, 
+	const GFC_INTEGER_8 * const restrict pwhich,
+	GFC_INTEGER_4 array_length)
+{
+  cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+}
+
 #endif
diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c
index e16db20..63b75bd 100644
--- a/libgfortran/generated/eoshift1_16.c
+++ b/libgfortran/generated/eoshift1_16.c
@@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret,
 	const gfc_array_i16 * const restrict h,
 	const char * const restrict pbound, 
 	const GFC_INTEGER_16 * const restrict pwhich, 
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -234,9 +241,11 @@ eoshift1_16 (gfc_array_char * const restrict ret,
 	const char * const restrict pbound,
 	const GFC_INTEGER_16 * const restrict pwhich)
 {
-  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 void eoshift1_16_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict, 
@@ -256,7 +265,32 @@ eoshift1_16_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
+  eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+}
+
+
+void eoshift1_16_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict, 
+	const gfc_array_i16 * const restrict,
+	const char * const restrict, 
+	const GFC_INTEGER_16 * const restrict,
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_16_char4);
+
+void
+eoshift1_16_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i16 * const restrict h,
+	const char *  const restrict pbound, 
+	const GFC_INTEGER_16 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c
index 11cc71f..58ce7e9 100644
--- a/libgfortran/generated/eoshift1_4.c
+++ b/libgfortran/generated/eoshift1_4.c
@@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret,
 	const gfc_array_i4 * const restrict h,
 	const char * const restrict pbound, 
 	const GFC_INTEGER_4 * const restrict pwhich, 
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -234,9 +241,11 @@ eoshift1_4 (gfc_array_char * const restrict ret,
 	const char * const restrict pbound,
 	const GFC_INTEGER_4 * const restrict pwhich)
 {
-  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 void eoshift1_4_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict, 
@@ -256,7 +265,32 @@ eoshift1_4_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
+  eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+}
+
+
+void eoshift1_4_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict, 
+	const gfc_array_i4 * const restrict,
+	const char * const restrict, 
+	const GFC_INTEGER_4 * const restrict,
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_4_char4);
+
+void
+eoshift1_4_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i4 * const restrict h,
+	const char *  const restrict pbound, 
+	const GFC_INTEGER_4 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c
index 4b7d0e04..0e9c2f1 100644
--- a/libgfortran/generated/eoshift1_8.c
+++ b/libgfortran/generated/eoshift1_8.c
@@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret,
 	const gfc_array_i8 * const restrict h,
 	const char * const restrict pbound, 
 	const GFC_INTEGER_8 * const restrict pwhich, 
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -234,9 +241,11 @@ eoshift1_8 (gfc_array_char * const restrict ret,
 	const char * const restrict pbound,
 	const GFC_INTEGER_8 * const restrict pwhich)
 {
-  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 void eoshift1_8_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict, 
@@ -256,7 +265,32 @@ eoshift1_8_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
+  eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+}
+
+
+void eoshift1_8_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict, 
+	const gfc_array_i8 * const restrict,
+	const char * const restrict, 
+	const GFC_INTEGER_8 * const restrict,
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_8_char4);
+
+void
+eoshift1_8_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i8 * const restrict h,
+	const char *  const restrict pbound, 
+	const GFC_INTEGER_8 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c
index 1dda668..214f378 100644
--- a/libgfortran/generated/eoshift3_16.c
+++ b/libgfortran/generated/eoshift3_16.c
@@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret,
 	const gfc_array_i16 * const restrict h,
 	const gfc_array_char * const restrict bound, 
 	const GFC_INTEGER_16 * const restrict pwhich,
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -253,9 +260,11 @@ eoshift3_16 (gfc_array_char * const restrict ret,
 	const gfc_array_char * const restrict bound,
 	const GFC_INTEGER_16 * const restrict pwhich)
 {
-  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 extern void eoshift3_16_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict,
@@ -275,7 +284,32 @@ eoshift3_16_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
+  eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+}
+
+
+extern void eoshift3_16_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict,
+	const gfc_array_i16 * const restrict,
+	const gfc_array_char * const restrict,
+	const GFC_INTEGER_16 * const restrict, 
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift3_16_char4);
+
+void
+eoshift3_16_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i16 *  const restrict h,
+	const gfc_array_char * const restrict bound,
+	const GFC_INTEGER_16 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c
index aa46f7c..e96ef25 100644
--- a/libgfortran/generated/eoshift3_4.c
+++ b/libgfortran/generated/eoshift3_4.c
@@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret,
 	const gfc_array_i4 * const restrict h,
 	const gfc_array_char * const restrict bound, 
 	const GFC_INTEGER_4 * const restrict pwhich,
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -253,9 +260,11 @@ eoshift3_4 (gfc_array_char * const restrict ret,
 	const gfc_array_char * const restrict bound,
 	const GFC_INTEGER_4 * const restrict pwhich)
 {
-  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 extern void eoshift3_4_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict,
@@ -275,7 +284,32 @@ eoshift3_4_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
+  eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+}
+
+
+extern void eoshift3_4_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict,
+	const gfc_array_i4 * const restrict,
+	const gfc_array_char * const restrict,
+	const GFC_INTEGER_4 * const restrict, 
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift3_4_char4);
+
+void
+eoshift3_4_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i4 *  const restrict h,
+	const gfc_array_char * const restrict bound,
+	const GFC_INTEGER_4 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c
index 04e81b8..dc39b94 100644
--- a/libgfortran/generated/eoshift3_8.c
+++ b/libgfortran/generated/eoshift3_8.c
@@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret,
 	const gfc_array_i8 * const restrict h,
 	const gfc_array_char * const restrict bound, 
 	const GFC_INTEGER_8 * const restrict pwhich,
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -253,9 +260,11 @@ eoshift3_8 (gfc_array_char * const restrict ret,
 	const gfc_array_char * const restrict bound,
 	const GFC_INTEGER_8 * const restrict pwhich)
 {
-  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 extern void eoshift3_8_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict,
@@ -275,7 +284,32 @@ eoshift3_8_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
+  eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+}
+
+
+extern void eoshift3_8_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict,
+	const gfc_array_i8 * const restrict,
+	const gfc_array_char * const restrict,
+	const GFC_INTEGER_8 * const restrict, 
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift3_8_char4);
+
+void
+eoshift3_8_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const gfc_array_i8 *  const restrict h,
+	const gfc_array_char * const restrict bound,
+	const GFC_INTEGER_8 * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ' ';
+  eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 4244aca..60ef853 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1040,10 +1040,31 @@ GFORTRAN_1.1 {
     _gfortran_convert_char4_to_char1;
     _gfortran_cshift0_16;
     _gfortran_cshift0_16_char;
+    _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_16;
     _gfortran_eoshift0_16_char;
+    _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_16;
     _gfortran_eoshift2_16_char;
+    _gfortran_eoshift2_1_char4;
+    _gfortran_eoshift2_2_char4;
+    _gfortran_eoshift2_4_char4;
+    _gfortran_eoshift2_8_char4;
+    _gfortran_eoshift3_16_char4;
+    _gfortran_eoshift3_4_char4;
+    _gfortran_eoshift3_8_char4;
     _gfortran_erfc_scaled_r10;
     _gfortran_erfc_scaled_r16;
     _gfortran_erfc_scaled_r4;
@@ -1051,17 +1072,17 @@ GFORTRAN_1.1 {
     _gfortran_pack_char4;
     _gfortran_pack_s_char4;
     _gfortran_reshape_char4;
-    _gfortran_select_string_char4;
     _gfortran_selected_char_kind;
+    _gfortran_select_string_char4;
     _gfortran_spread_char4;
     _gfortran_spread_char4_scalar;
-    _gfortran_st_wait;
     _gfortran_string_index_char4;
     _gfortran_string_len_trim_char4;
     _gfortran_string_minmax_char4;
     _gfortran_string_scan_char4;
     _gfortran_string_trim_char4;
     _gfortran_string_verify_char4;
+    _gfortran_st_wait;
     _gfortran_transpose_char4;
     _gfortran_unpack0_char4;
     _gfortran_unpack1_char4;
diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index 7157465..76ce97e 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/libgfortran/intrinsics/cshift0.c
@@ -334,6 +334,24 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
 		      GFC_INTEGER_4 array_length)			      \
   {									      \
     cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length);	      \
+  }									      \
+									      \
+  extern void cshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4,	      \
+				   const gfc_array_char *,		      \
+				   const GFC_INTEGER_##N *,		      \
+				   const GFC_INTEGER_##N *, GFC_INTEGER_4);   \
+  export_proto(cshift0_##N##_char4);					      \
+									      \
+  void									      \
+  cshift0_##N##_char4 (gfc_array_char *ret,				      \
+		       GFC_INTEGER_4 ret_length __attribute__((unused)),      \
+		       const gfc_array_char *array,			      \
+		       const GFC_INTEGER_##N *pshift,			      \
+		       const GFC_INTEGER_##N *pdim,			      \
+		       GFC_INTEGER_4 array_length)			      \
+  {									      \
+    cshift0 (ret, array, *pshift, pdim ? *pdim : 1,			      \
+	     array_length * sizeof (gfc_char4_t));			      \
   }
 
 DEFINE_CSHIFT (1);
diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c
index c75199c..ac7a0ba 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA.  */
 static void
 eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
 	  int shift, const char * pbound, int which, index_type size,
-	  char filler)
+	  const char *filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -175,7 +175,14 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size ; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -223,7 +230,7 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
 		const GFC_INTEGER_##N *pdim)				      \
   {									      \
     eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
-	      GFC_DESCRIPTOR_SIZE (array), 0);				      \
+	      GFC_DESCRIPTOR_SIZE (array), "\0", 1);			      \
   }									      \
 									      \
   extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4,	      \
@@ -244,7 +251,30 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
 		       GFC_INTEGER_4 bound_length __attribute__((unused)))    \
   {									      \
     eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
-	      array_length, ' ');					      \
+	      array_length, " ", 1);					      \
+  }									      \
+									      \
+  extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4,	      \
+				    const gfc_array_char *,		      \
+				    const GFC_INTEGER_##N *, const char *,    \
+				    const GFC_INTEGER_##N *, GFC_INTEGER_4,   \
+				    GFC_INTEGER_4);			      \
+  export_proto(eoshift0_##N##_char4);					      \
+									      \
+  void									      \
+  eoshift0_##N##_char4 (gfc_array_char *ret,				      \
+			GFC_INTEGER_4 ret_length __attribute__((unused)),     \
+			const gfc_array_char *array,			      \
+			const GFC_INTEGER_##N *pshift,			      \
+			const char *pbound,				      \
+			const GFC_INTEGER_##N *pdim,			      \
+			GFC_INTEGER_4 array_length,			      \
+			GFC_INTEGER_4 bound_length __attribute__((unused)))   \
+  {									      \
+    static const gfc_char4_t space = (unsigned char) ' ';		      \
+    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      array_length * sizeof (gfc_char4_t), (const char *) &space,     \
+	      sizeof (gfc_char4_t));					      \
   }
 
 DEFINE_EOSHIFT (1);
diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c
index f74cb01..239d971 100644
--- a/libgfortran/intrinsics/eoshift2.c
+++ b/libgfortran/intrinsics/eoshift2.c
@@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA.  */
 static void
 eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
 	  int shift, const gfc_array_char *bound, int which,
-	  index_type size, char filler)
+	  index_type size, const char *filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -192,7 +192,14 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size ; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -243,7 +250,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
 		const GFC_INTEGER_##N *pdim)				      \
   {									      \
     eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
-	      GFC_DESCRIPTOR_SIZE (array), 0);				      \
+	      GFC_DESCRIPTOR_SIZE (array), "\0", 1);			      \
   }									      \
 									      \
   extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4,	      \
@@ -265,7 +272,31 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
 		       GFC_INTEGER_4 bound_length __attribute__((unused)))    \
   {									      \
     eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
-	      array_length, ' ');					      \
+	      array_length, " ", 1);					      \
+  }									      \
+									      \
+  extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4,	      \
+				    const gfc_array_char *,		      \
+				    const GFC_INTEGER_##N *,		      \
+				    const gfc_array_char *,		      \
+				    const GFC_INTEGER_##N *,		      \
+				    GFC_INTEGER_4, GFC_INTEGER_4);	      \
+  export_proto(eoshift2_##N##_char4);					      \
+									      \
+  void									      \
+  eoshift2_##N##_char4 (gfc_array_char *ret,				      \
+			GFC_INTEGER_4 ret_length __attribute__((unused)),     \
+			const gfc_array_char *array,			      \
+			const GFC_INTEGER_##N *pshift,			      \
+			const gfc_array_char *pbound,			      \
+			const GFC_INTEGER_##N *pdim,			      \
+			GFC_INTEGER_4 array_length,			      \
+			GFC_INTEGER_4 bound_length __attribute__((unused)))   \
+  {									      \
+    static const gfc_char4_t space = (unsigned char) ' ';		      \
+    eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      array_length * sizeof (gfc_char4_t), (const char *) &space,     \
+	      sizeof (gfc_char4_t));					      \
   }
 
 DEFINE_EOSHIFT (1);
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index 87e137e..0008db5 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -214,7 +214,7 @@ string_index (gfc_charlen_type slen, const CHARTYPE *str,
   gfc_charlen_type start, last, delta, i;
 
   if (sslen == 0)
-    return 1;
+    return back ? (slen + 1) : 1;
 
   if (sslen > slen)
     return 0;
diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4
index 735621d..28fae59 100644
--- a/libgfortran/m4/cshift1.m4
+++ b/libgfortran/m4/cshift1.m4
@@ -213,6 +213,7 @@ cshift1_'atype_kind` (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
 }
 
+
 void cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict array,
@@ -232,4 +233,24 @@ cshift1_'atype_kind`_char (gfc_array_char * const restrict ret,
   cshift1 (ret, array, h, pwhich, array_length);
 }
 
+
+void cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict array,
+	const 'atype` * const restrict h, 
+	const 'atype_name` * const restrict pwhich,
+	GFC_INTEGER_4);
+export_proto(cshift1_'atype_kind`_char4);
+
+void
+cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array,
+	const 'atype` * const restrict h, 
+	const 'atype_name` * const restrict pwhich,
+	GFC_INTEGER_4 array_length)
+{
+  cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+}
+
 #endif'
diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4
index efa38b2..8ce24ef 100644
--- a/libgfortran/m4/eoshift1.m4
+++ b/libgfortran/m4/eoshift1.m4
@@ -43,7 +43,7 @@ eoshift1 (gfc_array_char * const restrict ret,
 	const 'atype` * const restrict h,
 	const char * const restrict pbound, 
 	const 'atype_name` * const restrict pwhich, 
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -184,7 +184,14 @@ eoshift1 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -235,9 +242,11 @@ eoshift1_'atype_kind` (gfc_array_char * const restrict ret,
 	const char * const restrict pbound,
 	const 'atype_name` * const restrict pwhich)
 {
-  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 void eoshift1_'atype_kind`_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict, 
@@ -257,7 +266,32 @@ eoshift1_'atype_kind`_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift1 (ret, array, h, pbound, pwhich, array_length, ''` ''`);
+  eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+}
+
+
+void eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict, 
+	const 'atype` * const restrict,
+	const char * const restrict, 
+	const 'atype_name` * const restrict,
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_'atype_kind`_char4);
+
+void
+eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const 'atype` * const restrict h,
+	const char *  const restrict pbound, 
+	const 'atype_name` * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ''` ''`;
+  eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif'
diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4
index 050f527..081ff92 100644
--- a/libgfortran/m4/eoshift3.m4
+++ b/libgfortran/m4/eoshift3.m4
@@ -43,7 +43,7 @@ eoshift3 (gfc_array_char * const restrict ret,
 	const 'atype` * const restrict h,
 	const gfc_array_char * const restrict bound, 
 	const 'atype_name` * const restrict pwhich,
-	index_type size, char filler)
+	index_type size, const char * filler, index_type filler_len)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -199,7 +199,14 @@ eoshift3 (gfc_array_char * const restrict ret,
       else
 	while (n--)
 	  {
-	    memset (dest, filler, size);
+	    index_type i;
+
+	    if (filler_len == 1)
+	      memset (dest, filler[0], size);
+	    else
+	      for (i = 0; i < size; i += filler_len)
+		memcpy (&dest[i], filler, filler_len);
+
 	    dest += roffset;
 	  }
 
@@ -254,9 +261,11 @@ eoshift3_'atype_kind` (gfc_array_char * const restrict ret,
 	const gfc_array_char * const restrict bound,
 	const 'atype_name` * const restrict pwhich)
 {
-  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
+	    "\0", 1);
 }
 
+
 extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, 
 	GFC_INTEGER_4,
 	const gfc_array_char * const restrict,
@@ -276,7 +285,32 @@ eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret,
 	GFC_INTEGER_4 array_length,
 	GFC_INTEGER_4 bound_length __attribute__((unused)))
 {
-  eoshift3 (ret, array, h, bound, pwhich, array_length, ''` ''`);
+  eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+}
+
+
+extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict, 
+	GFC_INTEGER_4,
+	const gfc_array_char * const restrict,
+	const 'atype` * const restrict,
+	const gfc_array_char * const restrict,
+	const 'atype_name` * const restrict, 
+	GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift3_'atype_kind`_char4);
+
+void
+eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret,
+	GFC_INTEGER_4 ret_length __attribute__((unused)),
+	const gfc_array_char * const restrict array, 
+	const 'atype` *  const restrict h,
+	const gfc_array_char * const restrict bound,
+	const 'atype_name` * const restrict pwhich,
+	GFC_INTEGER_4 array_length,
+	GFC_INTEGER_4 bound_length __attribute__((unused)))
+{
+  static const gfc_char4_t space = (unsigned char) ''` ''`;
+  eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+	    (const char *) &space, sizeof (gfc_char4_t));
 }
 
 #endif'