trans-expr.c (gfc_conv_concat_op): Take care of nondefault character kinds.

	* trans-expr.c (gfc_conv_concat_op): Take care of nondefault
	character kinds.
	(gfc_build_compare_string): Add kind argument and use it.
	(gfc_conv_statement_function): Fix indentation.
	* gfortran.h (gfc_character_info): New structure.
	(gfc_character_kinds): New array.
	* trans-types.c (gfc_character_kinds, gfc_character_types,
	gfc_pcharacter_types): New array.
	(gfc_init_kinds): Fill character kinds array.
	(validate_character): Take care of nondefault character kinds.
	(gfc_build_uint_type): New function.
	(gfc_init_types): Take care of nondefault character kinds.
	(gfc_get_char_type, gfc_get_pchar_type): New functions.
	(gfc_get_character_type_len): Use gfc_get_char_type.
	* trans.h (gfc_build_compare_string): Adjust prototype.
	(gfor_fndecl_compare_string_char4, gfor_fndecl_concat_string_char4,
	gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
	gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
	gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
	gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4): New
	prototypes.
	* trans-types.h (gfc_get_char_type, gfc_get_pchar_type): New
	prototypes.
	* trans-decl.c (gfor_fndecl_compare_string_char4,
	gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
	gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
	gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
	gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4,
	gfor_fndecl_concat_string_char4): New function decls.
	(gfc_build_intrinsic_function_decls): Define new *_char4 function
	decls.
	* trans-intrinsic.c (gfc_conv_intrinsic_minmax_char,
	gfc_conv_intrinsic_len_trim, gfc_conv_intrinsic_ichar,
	gfc_conv_intrinsic_strcmp, gfc_conv_intrinsic_trim,
	gfc_conv_intrinsic_function): Deal with nondefault character kinds.

From-SVN: r135397

1 files changed, 31 insertions, 18 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 08c2591..563e840 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1003,15 +1003,11 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
 static void
 gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
 {
-  gfc_se lse;
-  gfc_se rse;
-  tree len;
-  tree type;
-  tree var;
-  tree tmp;
+  gfc_se lse, rse;
+  tree len, type, var, tmp, fndecl;
 
   gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
-	  && expr->value.op.op2->ts.type == BT_CHARACTER);
+	      && expr->value.op.op2->ts.type == BT_CHARACTER);
 
   gfc_init_se (&lse, se);
   gfc_conv_expr (&lse, expr->value.op.op1);
@@ -1036,9 +1032,14 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
   var = gfc_conv_string_tmp (se, type, len);
 
   /* Do the actual concatenation.  */
-  tmp = build_call_expr (gfor_fndecl_concat_string, 6,
-			 len, var,
-			 lse.string_length, lse.expr,
+  if (expr->ts.kind == 1)
+    fndecl = gfor_fndecl_concat_string;
+  else if (expr->ts.kind == 4)
+    fndecl = gfor_fndecl_concat_string_char4;
+  else
+    gcc_unreachable ();
+
+  tmp = build_call_expr (fndecl, 6, len, var, lse.string_length, lse.expr,
 			 rse.string_length, rse.expr);
   gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -1212,7 +1213,8 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
       gfc_conv_string_parameter (&rse);
 
       lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
-					   rse.string_length, rse.expr);
+					   rse.string_length, rse.expr,
+					   expr->value.op.op1->ts.kind);
       rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0);
       gfc_add_block_to_block (&lse.post, &rse.post);
     }
@@ -1313,7 +1315,7 @@ gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
    subtraction of them. Otherwise, we build a library call.  */
 
 tree
-gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2)
+gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind)
 {
   tree sc1;
   tree sc2;
@@ -1325,17 +1327,28 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2)
   sc1 = gfc_to_single_character (len1, str1);
   sc2 = gfc_to_single_character (len2, str2);
 
-  /* Deal with single character specially.  */
   if (sc1 != NULL_TREE && sc2 != NULL_TREE)
     {
+      /* Deal with single character specially.  */
       sc1 = fold_convert (integer_type_node, sc1);
       sc2 = fold_convert (integer_type_node, sc2);
       tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
     }
-   else
-     /* Build a call for the comparison.  */
-     tmp = build_call_expr (gfor_fndecl_compare_string, 4,
-			    len1, str1, len2, str2);
+  else
+    {
+      /* Build a call for the comparison.  */
+      tree fndecl;
+
+      if (kind == 1)
+	fndecl = gfor_fndecl_compare_string;
+      else if (kind == 4)
+	fndecl = gfor_fndecl_compare_string_char4;
+      else
+	gcc_unreachable ();
+
+      tmp = build_call_expr (fndecl, 4, len1, str1, len2, str2);
+    }
+
   return tmp;
 }
 
@@ -2981,7 +2994,7 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr)
           tree arglen;
 
           gcc_assert (fsym->ts.cl && fsym->ts.cl->length
-                  && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
+                     && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
 
           arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
           tmp = gfc_build_addr_expr (build_pointer_type (type),