aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/io.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/io.c')
-rw-r--r--gcc/fortran/io.c84
1 files changed, 49 insertions, 35 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 07848a1..736253f 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -117,7 +117,7 @@ format_token;
/* Local variables for checking format strings. The saved_token is
used to back up by a single format token during the parsing
process. */
-static char *format_string;
+static gfc_char_t *format_string;
static int format_length, use_last_char;
static format_token saved_token;
@@ -165,7 +165,7 @@ next_char (int in_string)
if (mode == MODE_COPY)
*format_string++ = c;
- c = TOUPPER ((unsigned char) c);
+ c = gfc_wide_toupper (c);
return c;
}
@@ -782,7 +782,7 @@ data_desc:
gfc_warning ("The H format specifier at %C is"
" a Fortran 95 deleted feature");
- if(mode == MODE_STRING)
+ if (mode == MODE_STRING)
{
format_string += value;
format_length -= value;
@@ -1010,7 +1010,8 @@ gfc_match_format (void)
e->ts.type = BT_CHARACTER;
e->ts.kind = gfc_default_character_kind;
e->where = start;
- e->value.character.string = format_string = gfc_getmem (format_length + 1);
+ e->value.character.string = format_string
+ = gfc_get_wide_string (format_length + 1);
e->value.character.length = format_length;
gfc_statement_label->format = e;
@@ -1412,13 +1413,13 @@ gfc_resolve_open (gfc_open *open)
static int
compare_to_allowed_values (const char *specifier, const char *allowed[],
const char *allowed_f2003[],
- const char *allowed_gnu[], char *value,
+ const char *allowed_gnu[], gfc_char_t *value,
const char *statement, bool warn)
{
int i;
unsigned int len;
- len = strlen (value);
+ len = gfc_wide_strlen (value);
if (len > 0)
{
for (len--; len > 0; len--)
@@ -1429,13 +1430,13 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
for (i = 0; allowed[i]; i++)
if (len == strlen (allowed[i])
- && strncasecmp (value, allowed[i], strlen (allowed[i])) == 0)
+ && gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0)
return 1;
for (i = 0; allowed_f2003 && allowed_f2003[i]; i++)
if (len == strlen (allowed_f2003[i])
- && strncasecmp (value, allowed_f2003[i], strlen (allowed_f2003[i]))
- == 0)
+ && gfc_wide_strncasecmp (value, allowed_f2003[i],
+ strlen (allowed_f2003[i])) == 0)
{
notification n = gfc_notification_std (GFC_STD_F2003);
@@ -1461,7 +1462,8 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
for (i = 0; allowed_gnu && allowed_gnu[i]; i++)
if (len == strlen (allowed_gnu[i])
- && strncasecmp (value, allowed_gnu[i], strlen (allowed_gnu[i])) == 0)
+ && gfc_wide_strncasecmp (value, allowed_gnu[i],
+ strlen (allowed_gnu[i])) == 0)
{
notification n = gfc_notification_std (GFC_STD_GNU);
@@ -1487,14 +1489,18 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
if (warn)
{
+ char *s = gfc_widechar_to_char (value, -1);
gfc_warning ("%s specifier in %s statement at %C has invalid value '%s'",
- specifier, statement, value);
+ specifier, statement, s);
+ gfc_free (s);
return 1;
}
else
{
+ char *s = gfc_widechar_to_char (value, -1);
gfc_error ("%s specifier in %s statement at %C has invalid value '%s'",
- specifier, statement, value);
+ specifier, statement, s);
+ gfc_free (s);
return 0;
}
}
@@ -1773,20 +1779,22 @@ gfc_match_open (void)
/* F2003, 9.4.5: If the STATUS= specifier has the value NEW or REPLACE,
the FILE= specifier shall appear. */
if (open->file == NULL
- && (strncasecmp (open->status->value.character.string, "replace", 7)
- == 0
- || strncasecmp (open->status->value.character.string, "new", 3)
- == 0))
+ && (gfc_wide_strncasecmp (open->status->value.character.string,
+ "replace", 7) == 0
+ || gfc_wide_strncasecmp (open->status->value.character.string,
+ "new", 3) == 0))
{
+ char *s = gfc_widechar_to_char (open->status->value.character.string,
+ -1);
warn_or_error ("The STATUS specified in OPEN statement at %C is "
- "'%s' and no FILE specifier is present",
- open->status->value.character.string);
+ "'%s' and no FILE specifier is present", s);
+ gfc_free (s);
}
/* F2003, 9.4.5: If the STATUS= specifier has the value SCRATCH,
the FILE= specifier shall not appear. */
- if (strncasecmp (open->status->value.character.string, "scratch", 7)
- == 0 && open->file)
+ if (gfc_wide_strncasecmp (open->status->value.character.string,
+ "scratch", 7) == 0 && open->file)
{
warn_or_error ("The STATUS specified in OPEN statement at %C "
"cannot have the value SCRATCH if a FILE specifier "
@@ -1798,8 +1806,8 @@ gfc_match_open (void)
if (open->form && open->form->expr_type == EXPR_CONSTANT
&& (open->delim || open->decimal || open->encoding || open->round
|| open->sign || open->pad || open->blank)
- && strncasecmp (open->form->value.character.string,
- "unformatted", 11) == 0)
+ && gfc_wide_strncasecmp (open->form->value.character.string,
+ "unformatted", 11) == 0)
{
const char *spec = (open->delim ? "DELIM "
: (open->pad ? "PAD " : open->blank
@@ -1810,7 +1818,8 @@ gfc_match_open (void)
}
if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT
- && strncasecmp (open->access->value.character.string, "stream", 6) == 0)
+ && gfc_wide_strncasecmp (open->access->value.character.string,
+ "stream", 6) == 0)
{
warn_or_error ("RECL specifier not allowed in OPEN statement at %C for "
"stream I/O");
@@ -1818,12 +1827,12 @@ gfc_match_open (void)
if (open->position
&& open->access && open->access->expr_type == EXPR_CONSTANT
- && !(strncasecmp (open->access->value.character.string,
- "sequential", 10) == 0
- || strncasecmp (open->access->value.character.string,
- "stream", 6) == 0
- || strncasecmp (open->access->value.character.string,
- "append", 6) == 0))
+ && !(gfc_wide_strncasecmp (open->access->value.character.string,
+ "sequential", 10) == 0
+ || gfc_wide_strncasecmp (open->access->value.character.string,
+ "stream", 6) == 0
+ || gfc_wide_strncasecmp (open->access->value.character.string,
+ "append", 6) == 0))
{
warn_or_error ("POSITION specifier in OPEN statement at %C only allowed "
"for stream or sequential ACCESS");
@@ -2939,9 +2948,12 @@ if (condition) \
if (dt->id)
{
- io_constraint (!dt->asynchronous
- || strcmp (dt->asynchronous->value.character.string,
- "yes"),
+ bool not_yes
+ = !dt->asynchronous
+ || gfc_wide_strlen (dt->asynchronous->value.character.string) != 3
+ || gfc_wide_strncasecmp (dt->asynchronous->value.character.string,
+ "yes", 3) != 0;
+ io_constraint (not_yes,
"ID= specifier at %L must be with ASYNCHRONOUS='yes' "
"specifier", &dt->id->where);
}
@@ -3137,9 +3149,11 @@ if (condition) \
if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
{
- const char * advance = expr->value.character.string;
- not_no = strcasecmp (advance, "no") != 0;
- not_yes = strcasecmp (advance, "yes") != 0;
+ const gfc_char_t *advance = expr->value.character.string;
+ not_no = gfc_wide_strlen (advance) != 2
+ || gfc_wide_strncasecmp (advance, "no", 2) != 0;
+ not_yes = gfc_wide_strlen (advance) != 3
+ || gfc_wide_strncasecmp (advance, "yes", 3) != 0;
}
else
{
generated by cgit v1.1 at 2024-08-21 09:21:59 +0000