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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@136129 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 36 insertions, 29 deletions

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 990a12789fe..73e14a3f1fa 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);