* arith.c: (gfc_arith_concat, gfc_compare_string,

[pf3gnuchains/gcc-fork.git] / gcc / fortran / simplify.c

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 5de686f..e87804c 100644 (file)
--- 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;