aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/simplify.c')
-rw-r--r--gcc/fortran/simplify.c107
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;
generated by cgit v1.1 at 2025-05-31 22:05:35 +0000