arith.c: (gfc_arith_concat...

	* arith.c: (gfc_arith_concat, gfc_compare_string,
	gfc_compare_with_Cstring, hollerith2representation,
	gfc_hollerith2int, gfc_hollerith2real, gfc_hollerith2complex,
	gfc_hollerith2character, gfc_hollerith2logical): Use wide
	characters for character constants.
	* data.c (create_character_intializer): Likewise.
	* decl.c (gfc_set_constant_character_len): Likewise.
	* dump-parse-tree.c (show_char_const): Correctly dump wide
	character strings.
	error.c (print_wide_char): Rename into gfc_print_wide_char.
	(show_locus): Adapt to new prototype of gfc_print_wide_char.
	expr.c (free_expr0): Representation is now disjunct from
	character string value, so we always free it.
	(gfc_copy_expr, find_substring_ref, gfc_simplify_expr): Adapt
	to wide character strings.
	* gfortran.h (gfc_expr): Make value.character.string a wide string.
	(gfc_wide_toupper, gfc_wide_strncasecmp, gfc_wide_memset,
	gfc_widechar_to_char, gfc_char_to_widechar): New prototypes.
	(gfc_get_wide_string): New macro.
	(gfc_print_wide_char): New prototype.
	* io.c (format_string): Make a wide string.
	(next_char, gfc_match_format, compare_to_allowed_values, 
	gfc_match_open): Deal with wide strings.
	* module.c (mio_expr): Convert between wide strings and ASCII ones.
	* primary.c (match_hollerith_constant, match_charkind_name): 
	Handle wide strings.
	* resolve.c (build_default_init_expr): Likewise.
	* scanner.c (gfc_wide_toupper, gfc_wide_memset,
	gfc_char_to_widechar): New functions.
	(wide_strchr, gfc_widechar_to_char, gfc_wide_strncasecmp):
	Changes in prototypes.
	(gfc_define_undef_line, load_line, preprocessor_line,
	include_line, load_file, gfc_read_orig_filename): Handle wide
	strings.
	* simplify.c (gfc_simplify_achar, gfc_simplify_adjustl,
	gfc_simplify_adjustr, gfc_simplify_char, gfc_simplify_iachar,
	gfc_simplify_ichar, simplify_min_max, gfc_simplify_new_line,
	gfc_simplify_repeat): Handle wide strings.
	(wide_strspn, wide_strcspn): New helper functions.
	(gfc_simplify_scan, gfc_simplify_trim, gfc_simplify_verify):
	Handle wide strings.
	* symbol.c (generate_isocbinding_symbol): Likewise.
	* target-memory.c (size_character, gfc_target_expr_size,
	encode_character, gfc_target_encode_expr, gfc_interpret_character,
	gfc_target_interpret_expr): Handle wide strings.
	* trans-const.c (gfc_conv_string_init): Lower wide strings to
	narrow ones.
	(gfc_conv_constant_to_tree): Likewise.
	* trans-expr.c (gfc_conv_substring_expr): Handle wide strings.
	* trans-io.c (gfc_new_nml_name_expr): Likewise.
	* trans-stmt.c (gfc_trans_label_assign): Likewise.

From-SVN: r135006

1 files changed, 76 insertions, 31 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 5de686f..e87804c 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -284,7 +284,7 @@ gfc_simplify_achar (gfc_expr *e, gfc_expr *k)
 
   result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
 
-  result->value.character.string = gfc_getmem (2);
+  result->value.character.string = gfc_get_wide_string (2);
 
   result->value.character.length = 1;
   result->value.character.string[0] = c;
@@ -343,7 +343,7 @@ gfc_simplify_adjustl (gfc_expr *e)
 {
   gfc_expr *result;
   int count, i, len;
-  char ch;
+  gfc_char_t ch;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -353,7 +353,7 @@ gfc_simplify_adjustl (gfc_expr *e)
   result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where);
 
   result->value.character.length = len;
-  result->value.character.string = gfc_getmem (len + 1);
+  result->value.character.string = gfc_get_wide_string (len + 1);
 
   for (count = 0, i = 0; i < len; ++i)
     {
@@ -380,7 +380,7 @@ gfc_simplify_adjustr (gfc_expr *e)
 {
   gfc_expr *result;
   int count, i, len;
-  char ch;
+  gfc_char_t ch;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -390,7 +390,7 @@ gfc_simplify_adjustr (gfc_expr *e)
   result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where);
 
   result->value.character.length = len;
-  result->value.character.string = gfc_getmem (len + 1);
+  result->value.character.string = gfc_get_wide_string (len + 1);
 
   for (count = 0, i = len - 1; i >= 0; --i)
     {
@@ -843,7 +843,7 @@ gfc_simplify_char (gfc_expr *e, gfc_expr *k)
   result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
 
   result->value.character.length = 1;
-  result->value.character.string = gfc_getmem (2);
+  result->value.character.string = gfc_get_wide_string (2);
 
   result->value.character.string[0] = c;
   result->value.character.string[1] = '\0';	/* For debugger */
@@ -1460,7 +1460,7 @@ gfc_expr *
 gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
-  int index;
+  gfc_char_t index;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -1471,7 +1471,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
       return &gfc_bad_expr;
     }
 
-  index = (unsigned char) e->value.character.string[0];
+  index = e->value.character.string[0];
 
   if (gfc_option.warn_surprising && index > 127)
     gfc_warning ("Argument of IACHAR function at %L outside of range 0..127",
@@ -1649,7 +1649,7 @@ gfc_expr *
 gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
-  int index;
+  gfc_char_t index;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -1660,9 +1660,8 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
       return &gfc_bad_expr;
     }
 
-  index = (unsigned char) e->value.character.string[0];
-
-  if (index < 0 || index > UCHAR_MAX)
+  index = e->value.character.string[0];
+  if (index > UCHAR_MAX)
     gfc_internal_error("Argument of ICHAR at %L out of range", &e->where);
 
   if ((result = int_expr_with_kind (index, kind, "ICHAR")) == NULL)
@@ -2687,12 +2686,13 @@ simplify_min_max (gfc_expr *expr, int sign)
 #define STRING(x) ((x)->expr->value.character.string)
 	  if (LENGTH(extremum) < LENGTH(arg))
 	    {
-	      char * tmp = STRING(extremum);
+	      gfc_char_t *tmp = STRING(extremum);
 
-	      STRING(extremum) = gfc_getmem (LENGTH(arg) + 1);
-	      memcpy (STRING(extremum), tmp, LENGTH(extremum));
-	      memset (&STRING(extremum)[LENGTH(extremum)], ' ',
-		      LENGTH(arg) - LENGTH(extremum));
+	      STRING(extremum) = gfc_get_wide_string (LENGTH(arg) + 1);
+	      memcpy (STRING(extremum), tmp,
+		      LENGTH(extremum) * sizeof (gfc_char_t));
+	      gfc_wide_memset (&STRING(extremum)[LENGTH(extremum)], ' ',
+			       LENGTH(arg) - LENGTH(extremum));
 	      STRING(extremum)[LENGTH(arg)] = '\0';  /* For debugger  */
 	      LENGTH(extremum) = LENGTH(arg);
 	      gfc_free (tmp);
@@ -2701,10 +2701,11 @@ simplify_min_max (gfc_expr *expr, int sign)
 	  if (gfc_compare_string (arg->expr, extremum->expr) * sign > 0)
 	    {
 	      gfc_free (STRING(extremum));
-	      STRING(extremum) = gfc_getmem (LENGTH(extremum) + 1);
-	      memcpy (STRING(extremum), STRING(arg), LENGTH(arg));
-	      memset (&STRING(extremum)[LENGTH(arg)], ' ',
-		      LENGTH(extremum) - LENGTH(arg));
+	      STRING(extremum) = gfc_get_wide_string (LENGTH(extremum) + 1);
+	      memcpy (STRING(extremum), STRING(arg),
+		      LENGTH(arg) * sizeof (gfc_char_t));
+	      gfc_wide_memset (&STRING(extremum)[LENGTH(arg)], ' ',
+			       LENGTH(extremum) - LENGTH(arg));
 	      STRING(extremum)[LENGTH(extremum)] = '\0';  /* For debugger  */
 	    }
 #undef LENGTH
@@ -3008,7 +3009,7 @@ gfc_simplify_new_line (gfc_expr *e)
   gfc_expr *result;
 
   result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where);
-  result->value.character.string = gfc_getmem (2);
+  result->value.character.string = gfc_get_wide_string (2);
   result->value.character.length = 1;
   result->value.character.string[0] = '\n';
   result->value.character.string[1] = '\0';     /* For debugger */
@@ -3329,19 +3330,18 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
 
   if (ncop == 0)
     {
-      result->value.character.string = gfc_getmem (1);
+      result->value.character.string = gfc_get_wide_string (1);
       result->value.character.length = 0;
       result->value.character.string[0] = '\0';
       return result;
     }
 
   result->value.character.length = nlen;
-  result->value.character.string = gfc_getmem (nlen + 1);
+  result->value.character.string = gfc_get_wide_string (nlen + 1);
 
   for (i = 0; i < ncop; i++)
     for (j = 0; j < len; j++)
-      result->value.character.string[j + i * len]
-      = e->value.character.string[j];
+      result->value.character.string[j+i*len]= e->value.character.string[j];
 
   result->value.character.string[nlen] = '\0';	/* For debugger */
   return result;
@@ -3696,6 +3696,51 @@ gfc_simplify_scale (gfc_expr *x, gfc_expr *i)
 }
 
 
+/* Variants of strspn and strcspn that operate on wide characters.  */
+
+static size_t
+wide_strspn (const gfc_char_t *s1, const gfc_char_t *s2)
+{
+  size_t i = 0;
+  const gfc_char_t *c;
+
+  while (s1[i])
+    {
+      for (c = s2; *c; c++)
+	{
+	  if (s1[i] == *c)
+	    break;
+	}
+      if (*c == '\0')
+	break;
+      i++;
+    }
+
+  return i;
+}
+
+static size_t
+wide_strcspn (const gfc_char_t *s1, const gfc_char_t *s2)
+{
+  size_t i = 0;
+  const gfc_char_t *c;
+
+  while (s1[i])
+    {
+      for (c = s2; *c; c++)
+	{
+	  if (s1[i] == *c)
+	    break;
+	}
+      if (*c)
+	break;
+      i++;
+    }
+
+  return i;
+}
+
+
 gfc_expr *
 gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind)
 {
@@ -3729,8 +3774,8 @@ gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind)
     {
       if (back == 0)
 	{
-	  indx = strcspn (e->value.character.string, c->value.character.string)
-	       + 1;
+	  indx = wide_strcspn (e->value.character.string,
+			       c->value.character.string) + 1;
 	  if (indx > len)
 	    indx = 0;
 	}
@@ -4435,7 +4480,7 @@ gfc_simplify_trim (gfc_expr *e)
   lentrim = len - count;
 
   result->value.character.length = lentrim;
-  result->value.character.string = gfc_getmem (lentrim + 1);
+  result->value.character.string = gfc_get_wide_string (lentrim + 1);
 
   for (i = 0; i < lentrim; i++)
     result->value.character.string[i] = e->value.character.string[i];
@@ -4492,8 +4537,8 @@ gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b, gfc_expr *kind)
 	  return result;
 	}
 
-      index = strspn (s->value.character.string, set->value.character.string)
-	    + 1;
+      index = wide_strspn (s->value.character.string,
+			   set->value.character.string) + 1;
       if (index > len)
 	index = 0;