1 files changed, 80 insertions, 16 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 2a3c6bd..4b7e17d 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -143,6 +143,24 @@ gfc_resolve_access (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
 }
 
 
+void
+gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind);
+}
+
+
+void
+gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind);
+}
+
+
 static void
 gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
 			const char *name)
@@ -1690,11 +1708,27 @@ gfc_resolve_pack (gfc_expr *f, gfc_expr *array, gfc_expr *mask,
   resolve_mask_arg (mask);
 
   if (mask->rank != 0)
-    f->value.function.name = (array->ts.type == BT_CHARACTER
-			      ? PREFIX ("pack_char") : PREFIX ("pack"));
+    {
+      if (array->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = array->ts.kind == 1 ? PREFIX ("pack_char")
+				: gfc_get_string
+					(PREFIX ("pack_char%d"),
+					 array->ts.kind);
+      else
+	f->value.function.name = PREFIX ("pack");
+    }
   else
-    f->value.function.name = (array->ts.type == BT_CHARACTER
-			      ? PREFIX ("pack_s_char") : PREFIX ("pack_s"));
+    {
+      if (array->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = array->ts.kind == 1 ? PREFIX ("pack_s_char")
+				: gfc_get_string
+					(PREFIX ("pack_s_char%d"),
+					 array->ts.kind);
+      else
+	f->value.function.name = PREFIX ("pack_s");
+    }
 }
 
 
@@ -1801,6 +1835,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
     case BT_REAL:
     case BT_INTEGER:
     case BT_LOGICAL:
+    case BT_CHARACTER:
       kind = source->ts.kind;
       break;
 
@@ -1820,15 +1855,17 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
 	  = gfc_get_string (PREFIX ("reshape_%c%d"),
 			    gfc_type_letter (source->ts.type),
 			    source->ts.kind);
+      else if (source->ts.type == BT_CHARACTER)
+	f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"),
+						 kind);
       else
 	f->value.function.name
 	  = gfc_get_string (PREFIX ("reshape_%d"), source->ts.kind);
-
       break;
 
     default:
       f->value.function.name = (source->ts.type == BT_CHARACTER
-			     ? PREFIX ("reshape_char") : PREFIX ("reshape"));
+				? PREFIX ("reshape_char") : PREFIX ("reshape"));
       break;
     }
 
@@ -2000,13 +2037,27 @@ gfc_resolve_spread (gfc_expr *f, gfc_expr *source, gfc_expr *dim,
   f->ts = source->ts;
   f->rank = source->rank + 1;
   if (source->rank == 0)
-    f->value.function.name = (source->ts.type == BT_CHARACTER
-			      ? PREFIX ("spread_char_scalar")
-			      : PREFIX ("spread_scalar"));
+    {
+      if (source->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = source->ts.kind == 1 ? PREFIX ("spread_char_scalar")
+				 : gfc_get_string
+					(PREFIX ("spread_char%d_scalar"),
+					 source->ts.kind);
+      else
+	f->value.function.name = PREFIX ("spread_scalar");
+    }
   else
-    f->value.function.name = (source->ts.type == BT_CHARACTER
-			      ? PREFIX ("spread_char")
-			      : PREFIX ("spread"));
+    {
+      if (source->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = source->ts.kind == 1 ? PREFIX ("spread_char")
+				 : gfc_get_string
+					(PREFIX ("spread_char%d"),
+					 source->ts.kind);
+      else
+	f->value.function.name = PREFIX ("spread");
+    }
 
   if (dim && gfc_is_constant_expr (dim)
       && ncopies && gfc_is_constant_expr (ncopies) && source->shape[0])
@@ -2313,7 +2364,10 @@ gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix)
 	  break;
 
 	default:
-	  f->value.function.name = PREFIX ("transpose");
+	  if (matrix->ts.type == BT_CHARACTER && matrix->ts.kind == 4)
+	    f->value.function.name = PREFIX ("transpose_char4");
+	  else
+	    f->value.function.name = PREFIX ("transpose");
 	  break;
 	}
       break;
@@ -2413,9 +2467,19 @@ gfc_resolve_unpack (gfc_expr *f, gfc_expr *vector, gfc_expr *mask,
   f->rank = mask->rank;
   resolve_mask_arg (mask);
 
-  f->value.function.name
-    = gfc_get_string (PREFIX ("unpack%d%s"), field->rank > 0 ? 1 : 0,
-		      vector->ts.type == BT_CHARACTER ? "_char" : "");
+  if (vector->ts.type == BT_CHARACTER)
+    {
+      if (vector->ts.kind == 1)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("unpack%d_char"), field->rank > 0 ? 1 : 0);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("unpack%d_char%d"),
+			    field->rank > 0 ? 1 : 0, vector->ts.kind);
+    }
+  else
+    f->value.function.name
+      = gfc_get_string (PREFIX ("unpack%d"), field->rank > 0 ? 1 : 0);
 }