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

8 files changed, 339 insertions, 243 deletions

diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index e491e178e36..199e28314ce 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/libgfortran/intrinsics/cshift0.c
@@ -78,7 +78,7 @@ DEF_COPY_LOOP(cdouble, _Complex double)
 
 static void
 cshift0 (gfc_array_char * ret, const gfc_array_char * array,
-	 ssize_t shift, int which)
+	 ssize_t shift, int which, index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -95,7 +95,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type dim;
-  index_type size;
   index_type len;
   index_type n;
   int whichloop;
@@ -107,7 +106,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
 
   extent[0] = 1;
   count[0] = 0;
-  size = GFC_DESCRIPTOR_SIZE (array);
   n = 0;
 
   /* The values assigned here must match the cases in the inner loop.  */
@@ -298,51 +296,37 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
     }
 }
 
-
-extern void cshift0_1 (gfc_array_char *, const gfc_array_char *,
-		       const GFC_INTEGER_1 *, const GFC_INTEGER_1 *);
-export_proto(cshift0_1);
-
-void
-cshift0_1 (gfc_array_char *ret, const gfc_array_char *array,
-	   const GFC_INTEGER_1 *pshift, const GFC_INTEGER_1 *pdim)
-{
-  cshift0 (ret, array, *pshift, pdim ? *pdim : 1);
-}
-
-
-extern void cshift0_2 (gfc_array_char *, const gfc_array_char *,
-		       const GFC_INTEGER_2 *, const GFC_INTEGER_2 *);
-export_proto(cshift0_2);
-
-void
-cshift0_2 (gfc_array_char *ret, const gfc_array_char *array,
-	   const GFC_INTEGER_2 *pshift, const GFC_INTEGER_2 *pdim)
-{
-  cshift0 (ret, array, *pshift, pdim ? *pdim : 1);
-}
-
-
-extern void cshift0_4 (gfc_array_char *, const gfc_array_char *,
-		       const GFC_INTEGER_4 *, const GFC_INTEGER_4 *);
-export_proto(cshift0_4);
-
-void
-cshift0_4 (gfc_array_char *ret, const gfc_array_char *array,
-	   const GFC_INTEGER_4 *pshift, const GFC_INTEGER_4 *pdim)
-{
-  cshift0 (ret, array, *pshift, pdim ? *pdim : 1);
-}
-
-
-extern void cshift0_8 (gfc_array_char *, const gfc_array_char *,
-		       const GFC_INTEGER_8 *, const GFC_INTEGER_8 *);
-export_proto(cshift0_8);
-
-void
-cshift0_8 (gfc_array_char *ret, const gfc_array_char *array,
-	   const GFC_INTEGER_8 *pshift, const GFC_INTEGER_8 *pdim)
-{
-  cshift0 (ret, array, *pshift, pdim ? *pdim : 1);
-}
-
+#define DEFINE_CSHIFT(N)						      \
+  extern void cshift0_##N (gfc_array_char *, const gfc_array_char *,	      \
+			   const GFC_INTEGER_##N *, const GFC_INTEGER_##N *); \
+  export_proto(cshift0_##N);						      \
+									      \
+  void									      \
+  cshift0_##N (gfc_array_char *ret, const gfc_array_char *array,	      \
+	       const GFC_INTEGER_##N *pshift, const GFC_INTEGER_##N *pdim)    \
+  {									      \
+    cshift0 (ret, array, *pshift, pdim ? *pdim : 1,			      \
+	     GFC_DESCRIPTOR_SIZE (array));				      \
+  }									      \
+									      \
+  extern void cshift0_##N##_char (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##_char);					      \
+									      \
+  void									      \
+  cshift0_##N##_char (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);	      \
+  }
+
+DEFINE_CSHIFT (1);
+DEFINE_CSHIFT (2);
+DEFINE_CSHIFT (4);
+DEFINE_CSHIFT (8);
diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c
index b8dfb40be3c..6f02f66d36e 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -34,15 +34,13 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
-static const char zeros[16] =
-  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
-
 /* TODO: make this work for large shifts when
    sizeof(int) < sizeof (index_type).  */
 
 static void
 eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
-	  int shift, const char * pbound, int which)
+	  int shift, const char * pbound, int which, index_type size,
+	  char filler)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -60,7 +58,6 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type dim;
-  index_type size;
   index_type len;
   index_type n;
 
@@ -70,11 +67,6 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
   soffset = 0;
   roffset = 0;
 
-  if (!pbound)
-    pbound = zeros;
-
-  size = GFC_DESCRIPTOR_SIZE (ret);
-
   if (ret->data == NULL)
     {
       int i;
@@ -98,7 +90,6 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
 
   extent[0] = 1;
   count[0] = 0;
-  size = GFC_DESCRIPTOR_SIZE (array);
   n = 0;
   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
     {
@@ -174,11 +165,18 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
           n = -shift;
         }
 
-      while (n--)
-        {
-          memcpy (dest, pbound, size);
-          dest += roffset;
-        }
+      if (pbound)
+	while (n--)
+	  {
+	    memcpy (dest, pbound, size);
+	    dest += roffset;
+	  }
+      else
+	while (n--)
+	  {
+	    memset (dest, filler, size);
+	    dest += roffset;
+	  }
 
       /* Advance to the next section.  */
       rptr += rstride0;
@@ -212,57 +210,43 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
 }
 
 
-extern void eoshift0_1 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_1 *, const char *,
-			const GFC_INTEGER_1 *);
-export_proto(eoshift0_1);
-
-void
-eoshift0_1 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_1 *pshift, const char *pbound,
-	    const GFC_INTEGER_1 *pdim)
-{
-  eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift0_2 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_2 *, const char *,
-			const GFC_INTEGER_2 *);
-export_proto(eoshift0_2);
-
-void
-eoshift0_2 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_2 *pshift, const char *pbound,
-	    const GFC_INTEGER_2 *pdim)
-{
-  eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift0_4 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_4 *, const char *,
-			const GFC_INTEGER_4 *);
-export_proto(eoshift0_4);
-
-void
-eoshift0_4 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_4 *pshift, const char *pbound,
-	    const GFC_INTEGER_4 *pdim)
-{
-  eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift0_8 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_8 *, const char *,
-			const GFC_INTEGER_8 *);
-export_proto(eoshift0_8);
-
-void
-eoshift0_8 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_8 *pshift, const char *pbound,
-	    const GFC_INTEGER_8 *pdim)
-{
-  eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
-}
+#define DEFINE_EOSHIFT(N)						      \
+  extern void eoshift0_##N (gfc_array_char *, const gfc_array_char *,	      \
+			    const GFC_INTEGER_##N *, const char *,	      \
+			    const GFC_INTEGER_##N *);			      \
+  export_proto(eoshift0_##N);						      \
+									      \
+  void									      \
+  eoshift0_##N (gfc_array_char *ret, const gfc_array_char *array,	      \
+		const GFC_INTEGER_##N *pshift, const char *pbound,	      \
+		const GFC_INTEGER_##N *pdim)				      \
+  {									      \
+    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      GFC_DESCRIPTOR_SIZE (array), 0);				      \
+  }									      \
+									      \
+  extern void eoshift0_##N##_char (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##_char);					      \
+									      \
+  void									      \
+  eoshift0_##N##_char (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)))    \
+  {									      \
+    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      array_length, ' ');					      \
+  }
+
+DEFINE_EOSHIFT (1);
+DEFINE_EOSHIFT (2);
+DEFINE_EOSHIFT (4);
+DEFINE_EOSHIFT (8);
diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c
index dde9e1e64fa..f4990292ec4 100644
--- a/libgfortran/intrinsics/eoshift2.c
+++ b/libgfortran/intrinsics/eoshift2.c
@@ -34,15 +34,13 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
-static const char zeros[16] =
-  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
-
 /* TODO: make this work for large shifts when
    sizeof(int) < sizeof (index_type).  */
 
 static void
 eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
-	  int shift, const gfc_array_char *bound, int which)
+	  int shift, const gfc_array_char *bound, int which,
+	  index_type size, char filler)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -64,7 +62,6 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type dim;
-  index_type size;
   index_type len;
   index_type n;
 
@@ -74,8 +71,6 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
   soffset = 0;
   roffset = 0;
 
-  size = GFC_DESCRIPTOR_SIZE (ret);
-
   if (ret->data == NULL)
     {
       int i;
@@ -99,7 +94,6 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
 
   extent[0] = 1;
   count[0] = 0;
-  size = GFC_DESCRIPTOR_SIZE (array);
   n = 0;
   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
     {
@@ -156,7 +150,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
   if (bound)
     bptr = bound->data;
   else
-    bptr = zeros;
+    bptr = NULL;
 
   while (rptr)
     {
@@ -187,11 +181,18 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
           n = -shift;
         }
 
-      while (n--)
-        {
-          memcpy (dest, bptr, size);
-          dest += roffset;
-        }
+      if (bptr)
+	while (n--)
+	  {
+	    memcpy (dest, bptr, size);
+	    dest += roffset;
+	  }
+      else
+	while (n--)
+	  {
+	    memset (dest, filler, size);
+	    dest += roffset;
+	  }
 
       /* Advance to the next section.  */
       rptr += rstride0;
@@ -228,57 +229,44 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
 }
 
 
-extern void eoshift2_1 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_1 *, const gfc_array_char *,
-			const GFC_INTEGER_1 *);
-export_proto(eoshift2_1);
-
-void
-eoshift2_1 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_1 *pshift, const gfc_array_char *bound,
-	    const GFC_INTEGER_1 *pdim)
-{
-  eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift2_2 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_2 *, const gfc_array_char *,
-			const GFC_INTEGER_2 *);
-export_proto(eoshift2_2);
-
-void
-eoshift2_2 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_2 *pshift, const gfc_array_char *bound,
-	    const GFC_INTEGER_2 *pdim)
-{
-  eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift2_4 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_4 *, const gfc_array_char *,
-			const GFC_INTEGER_4 *);
-export_proto(eoshift2_4);
-
-void
-eoshift2_4 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_4 *pshift, const gfc_array_char *bound,
-	    const GFC_INTEGER_4 *pdim)
-{
-  eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1);
-}
-
-
-extern void eoshift2_8 (gfc_array_char *, const gfc_array_char *,
-			const GFC_INTEGER_8 *, const gfc_array_char *,
-			const GFC_INTEGER_8 *);
-export_proto(eoshift2_8);
-
-void
-eoshift2_8 (gfc_array_char *ret, const gfc_array_char *array,
-	    const GFC_INTEGER_8 *pshift, const gfc_array_char *bound,
-	    const GFC_INTEGER_8 *pdim)
-{
-  eoshift2 (ret, array, *pshift, bound, pdim ? *pdim : 1);
-}
+#define DEFINE_EOSHIFT(N)						      \
+  extern void eoshift2_##N (gfc_array_char *, const gfc_array_char *,	      \
+			    const GFC_INTEGER_##N *, const gfc_array_char *,  \
+			    const GFC_INTEGER_##N *);			      \
+  export_proto(eoshift2_##N);						      \
+									      \
+  void									      \
+  eoshift2_##N (gfc_array_char *ret, const gfc_array_char *array,	      \
+		const GFC_INTEGER_##N *pshift, const gfc_array_char *pbound,  \
+		const GFC_INTEGER_##N *pdim)				      \
+  {									      \
+    eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      GFC_DESCRIPTOR_SIZE (array), 0);				      \
+  }									      \
+									      \
+  extern void eoshift2_##N##_char (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##_char);					      \
+									      \
+  void									      \
+  eoshift2_##N##_char (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)))    \
+  {									      \
+    eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
+	      array_length, ' ');					      \
+  }
+
+DEFINE_EOSHIFT (1);
+DEFINE_EOSHIFT (2);
+DEFINE_EOSHIFT (4);
+DEFINE_EOSHIFT (8);
diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index 2b0be00e11d..f07b5aac905 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -74,13 +74,10 @@ Boston, MA 02110-1301, USA.  */
 There are two variants of the PACK intrinsic: one, where MASK is
 array valued, and the other one where MASK is scalar.  */
 
-extern void pack (gfc_array_char *, const gfc_array_char *,
-		  const gfc_array_l4 *, const gfc_array_char *);
-export_proto(pack);
-
-void
-pack (gfc_array_char *ret, const gfc_array_char *array,
-      const gfc_array_l4 *mask, const gfc_array_char *vector)
+static void
+pack_internal (gfc_array_char *ret, const gfc_array_char *array,
+	       const gfc_array_l4 *mask, const gfc_array_char *vector,
+	       index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rstride0;
@@ -98,10 +95,8 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type n;
   index_type dim;
-  index_type size;
   index_type nelem;
 
-  size = GFC_DESCRIPTOR_SIZE (array);
   dim = GFC_DESCRIPTOR_RANK (array);
   for (n = 0; n < dim; n++)
     {
@@ -189,7 +184,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 		  else
 		    {
 		      count[n]++;
-		      mptr += mstride[n];
+		      m += mstride[n];
 		    }
 		}
 	    }
@@ -277,13 +272,36 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
     }
 }
 
-extern void pack_s (gfc_array_char *ret, const gfc_array_char *array,
-		    const GFC_LOGICAL_4 *, const gfc_array_char *);
-export_proto(pack_s);
+extern void pack (gfc_array_char *, const gfc_array_char *,
+		  const gfc_array_l4 *, const gfc_array_char *);
+export_proto(pack);
 
 void
-pack_s (gfc_array_char *ret, const gfc_array_char *array,
-	const GFC_LOGICAL_4 *mask, const gfc_array_char *vector)
+pack (gfc_array_char *ret, const gfc_array_char *array,
+      const gfc_array_l4 *mask, const gfc_array_char *vector)
+{
+  pack_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array));
+}
+
+extern void pack_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *,
+		       const gfc_array_l4 *, const gfc_array_char *,
+		       GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(pack_char);
+
+void
+pack_char (gfc_array_char *ret,
+	   GFC_INTEGER_4 ret_length __attribute__((unused)),
+	   const gfc_array_char *array, const gfc_array_l4 *mask,
+	   const gfc_array_char *vector, GFC_INTEGER_4 array_length,
+	   GFC_INTEGER_4 vector_length __attribute__((unused)))
+{
+  pack_internal (ret, array, mask, vector, array_length);
+}
+
+static void
+pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
+		 const GFC_LOGICAL_4 *mask, const gfc_array_char *vector,
+		 index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rstride0;
@@ -297,10 +315,8 @@ pack_s (gfc_array_char *ret, const gfc_array_char *array,
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type n;
   index_type dim;
-  index_type size;
   index_type nelem;
 
-  size = GFC_DESCRIPTOR_SIZE (array);
   dim = GFC_DESCRIPTOR_RANK (array);
   for (n = 0; n < dim; n++)
     {
@@ -426,3 +442,30 @@ pack_s (gfc_array_char *ret, const gfc_array_char *array,
         }
     }
 }
+
+extern void pack_s (gfc_array_char *ret, const gfc_array_char *array,
+		    const GFC_LOGICAL_4 *, const gfc_array_char *);
+export_proto(pack_s);
+
+void
+pack_s (gfc_array_char *ret, const gfc_array_char *array,
+	const GFC_LOGICAL_4 *mask, const gfc_array_char *vector)
+{
+  pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array));
+}
+
+extern void pack_s_char (gfc_array_char *ret, GFC_INTEGER_4,
+			 const gfc_array_char *array, const GFC_LOGICAL_4 *,
+			 const gfc_array_char *, GFC_INTEGER_4,
+			 GFC_INTEGER_4);
+export_proto(pack_s_char);
+
+void
+pack_s_char (gfc_array_char *ret,
+	     GFC_INTEGER_4 ret_length __attribute__((unused)),
+	     const gfc_array_char *array, const GFC_LOGICAL_4 *mask,
+	     const gfc_array_char *vector, GFC_INTEGER_4 array_length,
+	     GFC_INTEGER_4 vector_length __attribute__((unused)))
+{
+  pack_s_internal (ret, array, mask, vector, array_length);
+}
diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c
index 1dc78cb3745..8cbdc89c0e2 100644
--- a/libgfortran/intrinsics/reshape_generic.c
+++ b/libgfortran/intrinsics/reshape_generic.c
@@ -37,15 +37,12 @@ Boston, MA 02110-1301, USA.  */
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray;
 
-extern void reshape (parray *, parray *, shape_type *, parray *, shape_type *);
-export_proto(reshape);
-
 /* The shape parameter is ignored. We can currently deduce the shape from the
    return array.  */
 
-void
-reshape (parray *ret, parray *source, shape_type *shape,
-	 parray *pad, shape_type *order)
+static void
+reshape_internal (parray *ret, parray *source, shape_type *shape,
+		  parray *pad, shape_type *order, index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rcount[GFC_MAX_DIMENSIONS];
@@ -76,7 +73,6 @@ reshape (parray *ret, parray *source, shape_type *shape,
   const char *src;
   int n;
   int dim;
-  int size;
 
   if (source->dim[0].stride == 0)
     source->dim[0].stride = 1;
@@ -89,7 +85,6 @@ reshape (parray *ret, parray *source, shape_type *shape,
 
   if (ret->data == NULL)
     {
-      size = GFC_DESCRIPTOR_SIZE (ret);
       rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
       rs = 1;
       for (n=0; n < rdim; n++)
@@ -106,7 +101,6 @@ reshape (parray *ret, parray *source, shape_type *shape,
     }
   else
     {
-      size = GFC_DESCRIPTOR_SIZE (ret);
       rdim = GFC_DESCRIPTOR_RANK (ret);
       if (ret->dim[0].stride == 0)
 	ret->dim[0].stride = 1;
@@ -260,3 +254,28 @@ reshape (parray *ret, parray *source, shape_type *shape,
         }
     }
 }
+
+extern void reshape (parray *, parray *, shape_type *, parray *, shape_type *);
+export_proto(reshape);
+
+void
+reshape (parray *ret, parray *source, shape_type *shape, parray *pad,
+	 shape_type *order)
+{
+  reshape_internal (ret, source, shape, pad, order,
+		    GFC_DESCRIPTOR_SIZE (source));
+}
+
+extern void reshape_char (parray *, GFC_INTEGER_4, parray *, shape_type *,
+			  parray *, shape_type *, GFC_INTEGER_4,
+			  GFC_INTEGER_4);
+export_proto(reshape_char);
+
+void
+reshape_char (parray *ret, GFC_INTEGER_4 ret_length __attribute__((unused)),
+	      parray *source, shape_type *shape, parray *pad,
+	      shape_type *order, GFC_INTEGER_4 source_length,
+	      GFC_INTEGER_4 pad_length __attribute__((unused)))
+{
+  reshape_internal (ret, source, shape, pad, order, source_length);
+}
diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 5de8f9c4fdb..a9cddb0f689 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -34,13 +34,10 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
-extern void spread (gfc_array_char *, const gfc_array_char *,
-		    const index_type *, const index_type *);
-export_proto(spread);
-
-void
-spread (gfc_array_char *ret, const gfc_array_char *source,
-	const index_type *along, const index_type *pncopies)
+static void
+spread_internal (gfc_array_char *ret, const gfc_array_char *source,
+		 const index_type *along, const index_type *pncopies,
+		 index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -60,7 +57,6 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type n;
   index_type dim;
-  index_type size;
   index_type ncopies;
 
   srank = GFC_DESCRIPTOR_RANK(source);
@@ -74,7 +70,6 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 
   ncopies = *pncopies;
 
-  size = GFC_DESCRIPTOR_SIZE (source);
   if (ret->data == NULL)
     {
       /* The front end has signalled that we need to populate the
@@ -180,3 +175,28 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
         }
     }
 }
+
+extern void spread (gfc_array_char *, const gfc_array_char *,
+		    const index_type *, const index_type *);
+export_proto(spread);
+
+void
+spread (gfc_array_char *ret, const gfc_array_char *source,
+	const index_type *along, const index_type *pncopies)
+{
+  spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source));
+}
+
+extern void spread_char (gfc_array_char *, GFC_INTEGER_4,
+			 const gfc_array_char *, const index_type *,
+			 const index_type *, GFC_INTEGER_4);
+export_proto(spread_char);
+
+void
+spread_char (gfc_array_char *ret,
+	     GFC_INTEGER_4 ret_length __attribute__((unused)),
+	     const gfc_array_char *source, const index_type *along,
+	     const index_type *pncopies, GFC_INTEGER_4 source_length)
+{
+  spread_internal (ret, source, along, pncopies, source_length);
+}
diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c
index 3b5ac96c63b..bd47073790b 100644
--- a/libgfortran/intrinsics/transpose_generic.c
+++ b/libgfortran/intrinsics/transpose_generic.c
@@ -37,8 +37,9 @@ Boston, MA 02110-1301, USA.  */
 extern void transpose (gfc_array_char *, gfc_array_char *);
 export_proto(transpose);
 
-void
-transpose (gfc_array_char *ret, gfc_array_char *source)
+static void
+transpose_internal (gfc_array_char *ret, gfc_array_char *source,
+		    index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rxstride, rystride;
@@ -49,13 +50,10 @@ transpose (gfc_array_char *ret, gfc_array_char *source)
 
   index_type xcount, ycount;
   index_type x, y;
-  index_type size;
 
   assert (GFC_DESCRIPTOR_RANK (source) == 2
           && GFC_DESCRIPTOR_RANK (ret) == 2);
 
-  size = GFC_DESCRIPTOR_SIZE (source);
-
   if (ret->data == NULL)
     {
       assert (ret->dtype == source->dtype);
@@ -100,3 +98,24 @@ transpose (gfc_array_char *ret, gfc_array_char *source)
       rptr += rxstride - (rystride * xcount);
     }
 }
+
+extern void transpose (gfc_array_char *, gfc_array_char *);
+export_proto(transpose);
+
+void
+transpose (gfc_array_char *ret, gfc_array_char *source)
+{
+  transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source));
+}
+
+extern void transpose_char (gfc_array_char *, GFC_INTEGER_4,
+			    gfc_array_char *, GFC_INTEGER_4);
+export_proto(transpose_char);
+
+void
+transpose_char (gfc_array_char *ret,
+		GFC_INTEGER_4 ret_length __attribute__((unused)),
+		gfc_array_char *source, GFC_INTEGER_4 source_length)
+{
+  transpose_internal (ret, source, source_length);
+}
diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c
index 1d6ff3d7d40..ac4394c21fe 100644
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/libgfortran/intrinsics/unpack_generic.c
@@ -34,13 +34,10 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
-extern void unpack1 (gfc_array_char *, const gfc_array_char *,
-		     const gfc_array_l4 *, const gfc_array_char *);
-iexport_proto(unpack1);
-
-void
-unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
-	 const gfc_array_l4 *mask, const gfc_array_char *field)
+static void
+unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
+		 const gfc_array_l4 *mask, const gfc_array_char *field,
+		 index_type size, index_type fsize)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -63,12 +60,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
   index_type extent[GFC_MAX_DIMENSIONS];
   index_type n;
   index_type dim;
-  index_type size;
-  index_type fsize;
 
-  size = GFC_DESCRIPTOR_SIZE (ret);
-  /* A field element size of 0 actually means this is a scalar.  */
-  fsize = GFC_DESCRIPTOR_SIZE (field);
   if (ret->data == NULL)
     {
       /* The front end has signalled that we need to populate the
@@ -177,7 +169,35 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
         }
     }
 }
-iexport(unpack1);
+
+extern void unpack1 (gfc_array_char *, const gfc_array_char *,
+		     const gfc_array_l4 *, const gfc_array_char *);
+export_proto(unpack1);
+
+void
+unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
+	 const gfc_array_l4 *mask, const gfc_array_char *field)
+{
+  unpack_internal (ret, vector, mask, field,
+		   GFC_DESCRIPTOR_SIZE (vector),
+		   GFC_DESCRIPTOR_SIZE (field));
+}
+
+extern void unpack1_char (gfc_array_char *, GFC_INTEGER_4,
+			  const gfc_array_char *, const gfc_array_l4 *,
+			  const gfc_array_char *, GFC_INTEGER_4,
+			  GFC_INTEGER_4);
+export_proto(unpack1_char);
+
+void
+unpack1_char (gfc_array_char *ret,
+	      GFC_INTEGER_4 ret_length __attribute__((unused)),
+	      const gfc_array_char *vector, const gfc_array_l4 *mask,
+	      const gfc_array_char *field, GFC_INTEGER_4 vector_length,
+	      GFC_INTEGER_4 field_length)
+{
+  unpack_internal (ret, vector, mask, field, vector_length, field_length);
+}
 
 extern void unpack0 (gfc_array_char *, const gfc_array_char *,
 		     const gfc_array_l4 *, char *);
@@ -191,5 +211,24 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 
   tmp.dtype = 0;
   tmp.data = field;
-  unpack1 (ret, vector, mask, &tmp);
+  unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector), 0);
+}
+
+extern void unpack0_char (gfc_array_char *, GFC_INTEGER_4,
+			  const gfc_array_char *, const gfc_array_l4 *,
+			  char *, GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(unpack0_char);
+
+void
+unpack0_char (gfc_array_char *ret,
+	      GFC_INTEGER_4 ret_length __attribute__((unused)),
+	      const gfc_array_char *vector, const gfc_array_l4 *mask,
+	      char *field, GFC_INTEGER_4 vector_length,
+	      GFC_INTEGER_4 field_length __attribute__((unused)))
+{
+  gfc_array_char tmp;
+
+  tmp.dtype = 0;
+  tmp.data = field;
+  unpack_internal (ret, vector, mask, &tmp, vector_length, 0);
 }