re PR fortran/19269 (transpose(reshape(...)) of character array segfaults.)

gcc/fortran/
	PR target/19269
	* iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift)
	(gfc_resolve_pack, gfc_resolve_reshape, gfc_resolve_spread)
	(gfc_resolve_transpose, gfc_resolve_unpack): Add "_char" to the name
	for character-based operations.
	(gfc_resolve_pack): Remove ATTRIBUTE_UNUSED from array argument.
	(gfc_resolve_unpack): Copy the whole typespec from the vector.
	* trans-array.c (gfc_conv_expr_descriptor): In the EXPR_FUNCTION
	case, get the string length from the scalarization state.

libgfortran/
	PR target/19269
	* intrinsics/cshift0.c (cshift0): Add an extra size argument.
	(cshift0_1, cshift0_2, cshift0_4, cshift0_8): Replace explicit
	implementations with...
	(DEFINE_CSHIFT): ...this new macro.  Define character versions too.
	* intrinsics/eoshift0.c (zeros): Delete.
	(eoshift0): Add extra size and filler arguments.  Use memset if no
	bound is provided.
	(eoshift0_1, eoshift0_2, eoshift0_4, eoshift0_8): Replace explicit
	implementations with...
	(DEFINE_EOSHIFT): ...this new macro.  Define character versions too.
	* intrinsics/eoshift2.c (zeros): Delete.
	(eoshift2): Add extra size and filler arguments.  Use memset if no
	bound is provided.
	(eoshift2_1, eoshift2_2, eoshift2_4, eoshift2_8): Replace explicit
	implementations with...
	(DEFINE_EOSHIFT): ...this new macro.  Define character versions too.
	* intrinsics/pack.c (pack_internal): New static function, reusing
	the contents of pack and adding an extra size argument.  Change
	"mptr" rather than "m" when calculating the array size.
	(pack): Redefine as a forwarder to pack_internal.
	(pack_s_internal): New static function, reusing the contents of
	pack_s and adding an extra size argument.
	(pack_s): Redefine as a forwarder to pack_s_internal.
	(pack_char, pack_s_char): New functions.
	* intrinsics/reshape.c (reshape_internal): New static function,
	reusing the contents of reshape and adding an extra size argument.
	(reshape): Redefine as a forwarder to reshape_internal.
	(reshape_char): New function.
	* intrinsics/spread.c (spread_internal): New static function,
	reusing the contents of spread and adding an extra size argument.
	(spread): Redefine as a forwarder to spread_internal.
	(spread_char): New function.
	* intrinsics/transpose.c (transpose_internal): New static function,
	reusing the contents of transpose and adding an extra size argument.
	(transpose): Redefine as a forwarder to transpose_internal.
	(transpose_char): New function.
	* intrinsics/unpack.c (unpack_internal): New static function, reusing
	the contents of unpack1 and adding extra size and fsize arguments.
	(unpack1): Redefine as a forwarder to unpack_internal.
	(unpack0): Call unpack_internal instead of unpack1.
	(unpack1_char, unpack0_char): New functions.
	* m4/cshift1.m4 (cshift1): New static function, reusing the contents
	of cshift1_<kind> and adding an extra size argument.
	(cshift1_<kind>): Redefine as a forwarder to cshift1.
	(cshift1_<kind>_char): New function.
	* m4/eoshift1.m4 (zeros): Delete.
	(eoshift1): New static function, reusing the contents of
	eoshift1_<kind> and adding extra size and filler arguments.
	Fix calculation of hstride.  Use memset if no bound is provided.
	(eoshift1_<kind>): Redefine as a forwarder to eoshift1.
	(eoshift1_<kind>_char): New function.
	* m4/eoshift3.m4 (zeros): Delete.
	(eoshift3): New static function, reusing the contents of
	eoshift3_<kind> and adding extra size and filler arguments.
	Use memset if no bound is provided.
	(eoshift3_<kind>): Redefine as a forwarder to eoshift3.
	(eoshift3_<kind>_char): New function.
	* generated/cshift1_4.c, generated/cshift1_8.c,
	* generated/eoshift1_4.c, generated/eoshift1_8.c,
	* generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerate.

From-SVN: r104217

1 files changed, 24 insertions, 13 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ef43946a55b..ed043a6b451 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -403,7 +403,8 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
 	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
   f->value.function.name =
-    gfc_get_string (PREFIX("cshift%d_%d"), n, shift->ts.kind);
+    gfc_get_string (PREFIX("cshift%d_%d%s"), n, shift->ts.kind,
+		    array->ts.type == BT_CHARACTER ? "_char" : "");
 }
 
 
@@ -503,7 +504,8 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
     }
 
   f->value.function.name =
-    gfc_get_string (PREFIX("eoshift%d_%d"), n, shift->ts.kind);
+    gfc_get_string (PREFIX("eoshift%d_%d%s"), n, shift->ts.kind,
+		    array->ts.type == BT_CHARACTER ? "_char" : "");
 }
 
 
@@ -1083,16 +1085,16 @@ gfc_resolve_not (gfc_expr * f, gfc_expr * i)
 
 
 void
-gfc_resolve_pack (gfc_expr * f,
-                  gfc_expr * array ATTRIBUTE_UNUSED,
-		  gfc_expr * mask,
+gfc_resolve_pack (gfc_expr * f, gfc_expr * array, gfc_expr * mask,
 		  gfc_expr * vector ATTRIBUTE_UNUSED)
 {
   f->ts = array->ts;
   f->rank = 1;
 
   if (mask->rank != 0)
-    f->value.function.name = PREFIX("pack");
+    f->value.function.name = (array->ts.type == BT_CHARACTER
+			      ? PREFIX("pack_char")
+			      : PREFIX("pack"));
   else
     {
       /* We convert mask to default logical only in the scalar case.
@@ -1107,7 +1109,9 @@ gfc_resolve_pack (gfc_expr * f,
 	  gfc_convert_type (mask, &ts, 2);
 	}
 
-      f->value.function.name = PREFIX("pack_s");
+      f->value.function.name = (array->ts.type == BT_CHARACTER
+				? PREFIX("pack_s_char")
+				: PREFIX("pack_s"));
     }
 }
 
@@ -1214,7 +1218,9 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
       break;
 
     default:
-      f->value.function.name = PREFIX("reshape");
+      f->value.function.name = (source->ts.type == BT_CHARACTER
+				? PREFIX("reshape_char")
+				: PREFIX("reshape"));
       break;
     }
 
@@ -1362,7 +1368,9 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
 {
   f->ts = source->ts;
   f->rank = source->rank + 1;
-  f->value.function.name = PREFIX("spread");
+  f->value.function.name = (source->ts.type == BT_CHARACTER
+			    ? PREFIX("spread_char")
+			    : PREFIX("spread"));
 
   gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);
@@ -1542,7 +1550,10 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
       break;
 
     default:
-      f->value.function.name = PREFIX("transpose");
+      f->value.function.name = (matrix->ts.type == BT_CHARACTER
+				? PREFIX("transpose_char")
+				: PREFIX("transpose"));
+      break;
     }
 }
 
@@ -1601,12 +1612,12 @@ void
 gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask,
 		    gfc_expr * field ATTRIBUTE_UNUSED)
 {
-  f->ts.type = vector->ts.type;
-  f->ts.kind = vector->ts.kind;
+  f->ts = vector->ts;
   f->rank = mask->rank;
 
   f->value.function.name =
-    gfc_get_string (PREFIX("unpack%d"), field->rank > 0 ? 1 : 0);
+    gfc_get_string (PREFIX("unpack%d%s"), field->rank > 0 ? 1 : 0,
+		    vector->ts.type == BT_CHARACTER ? "_char" : "");
 }