+2008-05-06 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * openmp.c (gfc_match_omp_eos): Use gfc_next_ascii_char and
+ gfc_peek_ascii_char.
+ * decl.c (gfc_match_kind_spec, gfc_match_type_spec,
+ gfc_match_implicit_none, match_implicit_range, gfc_match_implicit,
+ match_string_p, match_attr_spec, gfc_match_suffix,
+ match_procedure_decl, gfc_match_entry, gfc_match_subroutine):
+ Likewise.
+ * gfortran.h (gfc_char_t): New type.
+ (gfc_linebuf): Make line member a gfc_char_t.
+ (locus): Make nextc member a gfc_char_t.
+ (gfc_wide_is_printable, gfc_wide_is_digit, gfc_wide_fits_in_byte,
+ gfc_wide_tolower, gfc_wide_strlen, gfc_next_ascii_char,
+ gfc_peek_ascii_char, gfc_check_digit): New prototypes.
+ * error.c (print_wide_char): New function.
+ (show_locus): Use print_wide_char and gfc_wide_strlen.
+ * io.c (next_char): Use gfc_char_t type.
+ (match_io): Use gfc_peek_ascii_char and gfc_next_ascii_char.
+ * match.c (gfc_match_parens, gfc_match_eos,
+ gfc_match_small_literal_int, gfc_match_name, gfc_match_name_C,
+ gfc_match_intrinsic_op, gfc_match_char, gfc_match_return,
+ gfc_match_common): Likewise.
+ * match.h (gfc_match_special_char): Change prototype.
+ * parse.c (decode_specification_statement, decode_statement,
+ decode_omp_directive, next_free, next_fixed): Use
+ gfc_peek_ascii_char and gfc_next_ascii_char.
+ * primary.c (gfc_check_digit): Change name.
+ (match_digits, match_hollerith_constant, match_boz_constant,
+ match_real_constant, next_string_char, match_charkind_name,
+ match_string_constant, match_logical_constant_string,
+ match_complex_constant, match_actual_arg, match_varspec,
+ gfc_match_rvalue, match_variable): Use gfc_peek_ascii_char and
+ gfc_next_ascii_char.
+ * scanner.c (gfc_wide_fits_in_byte, wide_is_ascii,
+ gfc_wide_is_printable, gfc_wide_tolower, gfc_wide_is_digit,
+ gfc_wide_is_digit, wide_atoi, gfc_wide_strlen, wide_strcpy,
+ wide_strchr, widechar_to_char, wide_strncmp, wide_strncasecmp,
+ gfc_next_ascii_char, gfc_peek_ascii_char):
+ New functions.
+ (next_char, gfc_define_undef_line, skip_free_comments,
+ gfc_next_char_literal, gfc_next_char, gfc_peek_char,
+ gfc_error_recovery, load_line, preprocessor_line, include_line,
+ load_file, gfc_read_orig_filename): Use gfc_char_t for source
+ characters and the {gfc_,}wide_* functions to manipulate wide
+ strings.
+
2008-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/36117
}
gfc_gobble_whitespace ();
- if ((c = gfc_next_char ()) != ')' && (ts->type != BT_CHARACTER || c != ','))
+ if ((c = gfc_next_ascii_char ()) != ')'
+ && (ts->type != BT_CHARACTER || c != ','))
{
if (ts->type == BT_CHARACTER)
gfc_error ("Missing right parenthesis or comma at %C");
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
match m;
- int c;
+ char c;
bool seen_deferred_kind;
/* A belt and braces check that the typespec is correctly being treated
if (gfc_current_form == FORM_FREE)
{
- c = gfc_peek_char();
+ c = gfc_peek_ascii_char();
if (!gfc_is_whitespace(c) && c != '*' && c != '('
&& c != ':' && c != ',')
return MATCH_NO;
static match
match_implicit_range (void)
{
- int c, c1, c2, inner;
+ char c, c1, c2;
+ int inner;
locus cur_loc;
cur_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (c != '(')
{
gfc_error ("Missing character range in IMPLICIT at %C");
while (inner)
{
gfc_gobble_whitespace ();
- c1 = gfc_next_char ();
+ c1 = gfc_next_ascii_char ();
if (!ISALPHA (c1))
goto bad;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
switch (c)
{
case '-':
gfc_gobble_whitespace ();
- c2 = gfc_next_char ();
+ c2 = gfc_next_ascii_char ();
if (!ISALPHA (c2))
goto bad;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if ((c != ',') && (c != ')'))
goto bad;
{
gfc_typespec ts;
locus cur_loc;
- int c;
+ char c;
match m;
gfc_clear_ts (&ts);
{
/* We may have <TYPE> (<RANGE>). */
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if ((c == '\n') || (c == ','))
{
/* Check for CHARACTER with no length parameter. */
goto syntax;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if ((c != '\n') && (c != ','))
goto syntax;
const char *p;
for (p = target; *p; p++)
- if (gfc_next_char () != *p)
+ if ((char) gfc_next_ascii_char () != *p)
return false;
return true;
}
for (;;)
{
- int ch;
+ char ch;
d = DECL_NONE;
gfc_gobble_whitespace ();
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == ':')
{
/* This is the successful exit condition for the loop. */
- if (gfc_next_char () == ':')
+ if (gfc_next_ascii_char () == ':')
break;
}
else if (ch == ',')
{
gfc_gobble_whitespace ();
- switch (gfc_peek_char ())
+ switch (gfc_peek_ascii_char ())
{
case 'a':
if (match_string_p ("allocatable"))
case 'i':
if (match_string_p ("int"))
{
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
if (match_string_p ("nt"))
break;
case 'p':
- gfc_next_char ();
- switch (gfc_next_char ())
+ gfc_next_ascii_char ();
+ switch (gfc_next_ascii_char ())
{
case 'a':
if (match_string_p ("rameter"))
break;
case 'r':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'i')
{
if (match_string_p ("vate"))
break;
case 'v':
- gfc_next_char ();
- ch = gfc_next_char ();
+ gfc_next_ascii_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'a')
{
if (match_string_p ("lue"))
match is_bind_c; /* Found bind(c). */
match is_result; /* Found result clause. */
match found_match; /* Status of whether we've found a good match. */
- int peek_char; /* Character we're going to peek at. */
+ char peek_char; /* Character we're going to peek at. */
bool allow_binding_name;
/* Initialize to having found nothing. */
/* Get the next char to narrow between result and bind(c). */
gfc_gobble_whitespace ();
- peek_char = gfc_peek_char ();
+ peek_char = gfc_peek_ascii_char ();
/* C binding names are not allowed for internal procedures. */
if (gfc_current_state () == COMP_CONTAINS
/* Get the type spec. for the procedure interface. */
old_loc = gfc_current_locus;
m = gfc_match_type_spec (¤t_ts, 0);
- if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_char () == ')'))
+ if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_ascii_char () == ')'))
goto got_ts;
if (m == MATCH_ERROR)
/* Check what next non-whitespace character is so we can tell if there
is the required parens if we have a BIND(C). */
gfc_gobble_whitespace ();
- peek_char = gfc_peek_char ();
+ peek_char = gfc_peek_ascii_char ();
if (state == COMP_SUBROUTINE)
{
/* Check what next non-whitespace character is so we can tell if there
is the required parens if we have a BIND(C). */
gfc_gobble_whitespace ();
- peek_char = gfc_peek_char ();
+ peek_char = gfc_peek_ascii_char ();
if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
return MATCH_ERROR;
gfc_match_pointer (void)
{
gfc_gobble_whitespace ();
- if (gfc_peek_char () == '(')
+ if (gfc_peek_ascii_char () == '(')
{
if (!gfc_option.flag_cray_pointer)
{
locus. Calls error_printf() recursively, but the recursion is at
most one level deep. */
+static void
+print_wide_char (gfc_char_t c)
+{
+ static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
+ '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
+ char buf[9];
+
+ if (gfc_wide_is_printable (c))
+ error_char (c);
+ else if (c < ((gfc_char_t) 1 << 8))
+ {
+ buf[2] = '\0';
+ buf[1] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[0] = xdigit[c & 0x0F];
+
+ error_char ('\\');
+ error_char ('x');
+ error_string (buf);
+ }
+ else if (c < ((gfc_char_t) 1 << 16))
+ {
+ buf[4] = '\0';
+ buf[3] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[2] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[1] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[0] = xdigit[c & 0x0F];
+
+ error_char ('\\');
+ error_char ('u');
+ error_string (buf);
+ }
+ else
+ {
+ buf[8] = '\0';
+ buf[7] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[6] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[5] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[4] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[3] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[2] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[1] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[0] = xdigit[c & 0x0F];
+
+ error_char ('\\');
+ error_char ('U');
+ error_string (buf);
+ }
+}
+
static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
static void
{
gfc_linebuf *lb;
gfc_file *f;
- char c, *p;
- int i, m, offset, cmax;
+ gfc_char_t c, *p;
+ int i, offset, cmax;
/* TODO: Either limit the total length and number of included files
displayed or add buffering of arbitrary number of characters in
to work correctly when nonprintable characters exist. A better
solution should be found. */
- p = lb->line + offset;
- i = strlen (p);
+ p = &(lb->line[offset]);
+ i = gfc_wide_strlen (p);
if (i > terminal_width)
i = terminal_width - 1;
if (c == '\t')
c = ' ';
- if (ISPRINT (c))
- error_char (c);
- else
- {
- error_char ('\\');
- error_char ('x');
-
- m = ((c >> 4) & 0x0F) + '0';
- if (m > '9')
- m += 'A' - '9' - 1;
- error_char (m);
-
- m = (c & 0x0F) + '0';
- if (m > '9')
- m += 'A' - '9' - 1;
- error_char (m);
- }
+ print_wide_char (c);
}
error_char ('\n');
symbol_attribute;
+/* We need to store source lines as sequences of multibyte source
+ characters. We define here a type wide enough to hold any multibyte
+ source character, just like libcpp does. A 32-bit type is enough. */
+
+#if HOST_BITS_PER_INT >= 32
+typedef unsigned int gfc_char_t;
+#elif HOST_BITS_PER_LONG >= 32
+typedef unsigned long gfc_char_t;
+#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
+typedef unsigned long long gfc_char_t;
+#else
+# error "Cannot find an integer type with at least 32 bits"
+#endif
+
+
/* The following three structures are used to identify a location in
the sources.
int truncated;
bool dbg_emitted;
- char line[1];
+ gfc_char_t line[1];
} gfc_linebuf;
#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
typedef struct
{
- char *nextc;
+ gfc_char_t *nextc;
gfc_linebuf *lb;
} locus;
int gfc_check_include (void);
int gfc_define_undef_line (void);
+int gfc_wide_is_printable (gfc_char_t);
+int gfc_wide_is_digit (gfc_char_t);
+int gfc_wide_fits_in_byte (gfc_char_t);
+gfc_char_t gfc_wide_tolower (gfc_char_t);
+size_t gfc_wide_strlen (const gfc_char_t *);
+
void gfc_skip_comments (void);
-int gfc_next_char_literal (int);
-int gfc_next_char (void);
-int gfc_peek_char (void);
+gfc_char_t gfc_next_char_literal (int);
+gfc_char_t gfc_next_char (void);
+char gfc_next_ascii_char (void);
+gfc_char_t gfc_peek_char (void);
+char gfc_peek_ascii_char (void);
void gfc_error_recovery (void);
void gfc_gobble_whitespace (void);
try gfc_new_file (void);
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
symbol_attribute gfc_expr_attr (gfc_expr *);
match gfc_match_rvalue (gfc_expr **);
+int gfc_check_digit (char, int);
/* trans.c */
void gfc_generate_code (gfc_namespace *);
@opindex @code{backslash}
@cindex backslash
@cindex escape characters
-Change the interpretation of backslashes in string literals
-from a single backslash character to ``C-style'' escape characters.
-The following combinations are expanded \a, \b, \f, \n, \r, \t,
-\v, \\, and \0 to the ASCII characters alert, backspace, form feed,
-newline, carriage return, horizontal tab, vertical tab, backslash,
-and NUL, respectively. All other combinations of a character preceded
-by \ are unexpanded.
+Change the interpretation of backslashes in string literals from a single
+backslash character to ``C-style'' escape characters. The following
+combinations are expanded @code{\a}, @code{\b}, @code{\f}, @code{\n},
+@code{\r}, @code{\t}, @code{\v}, @code{\\}, and @code{\0} to the ASCII
+characters alert, backspace, form feed, newline, carriage return,
+horizontal tab, vertical tab, backslash, and NUL, respectively.
+Additionally, @code{\x}@var{nn}, @code{\u}@var{nnnn} and
+@code{\U}@var{nnnnnnnn} (where each @var{n} is a hexadecimal digit) are
+translated into the Unicode characters corresponding to the specified code
+points. All other combinations of a character preceded by \ are
+unexpanded.
@item -fmodule-private
@opindex @code{fmodule-private}
static char
next_char (int in_string)
{
- static char c;
+ static gfc_char_t c;
if (use_last_char)
{
if (gfc_option.flag_backslash && c == '\\')
{
- int tmp;
locus old_locus = gfc_current_locus;
- /* Use a temp variable to avoid side effects from gfc_match_special_char
- since it uses an int * for its argument. */
- tmp = (int)c;
-
- if (gfc_match_special_char (&tmp) == MATCH_NO)
+ if (gfc_match_special_char (&c) == MATCH_NO)
gfc_current_locus = old_locus;
- c = (char)tmp;
-
if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
gfc_warning ("Extension: backslash character at %C");
}
if (mode == MODE_COPY)
*format_string++ = c;
- c = TOUPPER (c);
+ c = TOUPPER ((unsigned char) c);
return c;
}
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_code *io_code;
gfc_symbol *sym;
- int comma_flag, c;
+ int comma_flag;
locus where;
locus spec_end;
gfc_dt *dt;
else if (k == M_PRINT)
{
/* Treat the non-standard case of PRINT namelist. */
- if ((gfc_current_form == FORM_FIXED || gfc_peek_char () == ' ')
+ if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ')
&& gfc_match_name (name) == MATCH_YES)
{
gfc_find_symbol (name, NULL, 1, &sym);
if (gfc_current_form == FORM_FREE)
{
- c = gfc_peek_char();
+ char c = gfc_peek_ascii_char ();
if (c != ' ' && c != '*' && c != '\'' && c != '"')
{
m = MATCH_NO;
gfc_match_parens (void)
{
locus old_loc, where;
- int c, count, instring;
- char quote;
+ int count, instring;
+ gfc_char_t c, quote;
old_loc = gfc_current_locus;
count = 0;
break;
if (quote == ' ' && ((c == '\'') || (c == '"')))
{
- quote = (char) c;
+ quote = c;
instring = 1;
continue;
}
escaped by a \ via the -fbackslash option. */
match
-gfc_match_special_char (int *c)
+gfc_match_special_char (gfc_char_t *res)
{
-
+ int len, i;
+ gfc_char_t c, n;
match m;
m = MATCH_YES;
- switch (gfc_next_char_literal (1))
+ switch ((c = gfc_next_char_literal (1)))
{
case 'a':
- *c = '\a';
+ *res = '\a';
break;
case 'b':
- *c = '\b';
+ *res = '\b';
break;
case 't':
- *c = '\t';
+ *res = '\t';
break;
case 'f':
- *c = '\f';
+ *res = '\f';
break;
case 'n':
- *c = '\n';
+ *res = '\n';
break;
case 'r':
- *c = '\r';
+ *res = '\r';
break;
case 'v':
- *c = '\v';
+ *res = '\v';
break;
case '\\':
- *c = '\\';
+ *res = '\\';
break;
case '0':
- *c = '\0';
+ *res = '\0';
+ break;
+
+ case 'x':
+ case 'u':
+ case 'U':
+ /* Hexadecimal form of wide characters. */
+ len = (c == 'x' ? 2 : (c == 'u' ? 4 : 8));
+ n = 0;
+ for (i = 0; i < len; i++)
+ {
+ char buf[2] = { '\0', '\0' };
+
+ c = gfc_next_char_literal (1);
+ if (!gfc_wide_fits_in_byte (c)
+ || !gfc_check_digit ((unsigned char) c, 16))
+ return MATCH_NO;
+
+ buf[0] = (unsigned char) c;
+ n = n << 4;
+ n += strtol (buf, NULL, 16);
+ }
+ *res = n;
break;
+
default:
/* Unknown backslash codes are simply not expanded. */
m = MATCH_NO;
gfc_match_space (void)
{
locus old_loc;
- int c;
+ char c;
if (gfc_current_form == FORM_FIXED)
return MATCH_YES;
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!gfc_is_whitespace (c))
{
gfc_current_locus = old_loc;
gfc_match_eos (void)
{
locus old_loc;
- int flag, c;
+ int flag;
+ char c;
flag = 0;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
switch (c)
{
case '!':
do
{
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
while (c != '\n');
old_loc = gfc_current_locus;
+ *value = -1;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (cnt)
*cnt = 0;
for (;;)
{
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!ISDIGIT (c))
break;
gfc_match_name (char *buffer)
{
locus old_loc;
- int i, c;
+ int i;
+ char c;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore)))
{
if (gfc_error_flag_test() == 0 && c != '(')
}
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$'));
if (c == '$' && !gfc_option.flag_dollar_ok)
{
- gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it as an extension");
+ gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it "
+ "as an extension");
return MATCH_ERROR;
}
{
locus old_loc;
int i = 0;
- int c;
+ gfc_char_t c;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
/* Continue to read valid variable name characters. */
do
{
- buffer[i++] = c;
+ gcc_assert (gfc_wide_fits_in_byte (c));
+
+ buffer[i++] = (unsigned char) c;
/* C does not define a maximum length of variable names, to my
knowledge, but the compiler typically places a limit on them.
if (c == ' ')
{
gfc_gobble_whitespace ();
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
if (c != '"' && c != '\'')
{
gfc_error ("Embedded space in NAME= specifier at %C");
gfc_match_intrinsic_op (gfc_intrinsic_op *result)
{
locus orig_loc = gfc_current_locus;
- int ch;
+ char ch;
gfc_gobble_whitespace ();
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
switch (ch)
{
case '+':
return MATCH_YES;
case '=':
- if (gfc_next_char () == '=')
+ if (gfc_next_ascii_char () == '=')
{
/* Matched "==". */
*result = INTRINSIC_EQ;
break;
case '<':
- if (gfc_peek_char () == '=')
+ if (gfc_peek_ascii_char () == '=')
{
/* Matched "<=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_LE;
return MATCH_YES;
}
return MATCH_YES;
case '>':
- if (gfc_peek_char () == '=')
+ if (gfc_peek_ascii_char () == '=')
{
/* Matched ">=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_GE;
return MATCH_YES;
}
return MATCH_YES;
case '*':
- if (gfc_peek_char () == '*')
+ if (gfc_peek_ascii_char () == '*')
{
/* Matched "**". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_POWER;
return MATCH_YES;
}
return MATCH_YES;
case '/':
- ch = gfc_peek_char ();
+ ch = gfc_peek_ascii_char ();
if (ch == '=')
{
/* Matched "/=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_NE;
return MATCH_YES;
}
else if (ch == '/')
{
/* Matched "//". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_CONCAT;
return MATCH_YES;
}
return MATCH_YES;
case '.':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
switch (ch)
{
case 'a':
- if (gfc_next_char () == 'n'
- && gfc_next_char () == 'd'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'n'
+ && gfc_next_ascii_char () == 'd'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".and.". */
*result = INTRINSIC_AND;
break;
case 'e':
- if (gfc_next_char () == 'q')
+ if (gfc_next_ascii_char () == 'q')
{
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == '.')
{
/* Matched ".eq.". */
}
else if (ch == 'v')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".eqv.". */
*result = INTRINSIC_EQV;
break;
case 'g':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".ge.". */
*result = INTRINSIC_GE_OS;
}
else if (ch == 't')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".gt.". */
*result = INTRINSIC_GT_OS;
break;
case 'l':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".le.". */
*result = INTRINSIC_LE_OS;
}
else if (ch == 't')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".lt.". */
*result = INTRINSIC_LT_OS;
break;
case 'n':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == '.')
{
/* Matched ".ne.". */
}
else if (ch == 'q')
{
- if (gfc_next_char () == 'v'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'v'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".neqv.". */
*result = INTRINSIC_NEQV;
}
else if (ch == 'o')
{
- if (gfc_next_char () == 't'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 't'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".not.". */
*result = INTRINSIC_NOT;
break;
case 'o':
- if (gfc_next_char () == 'r'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'r'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".or.". */
*result = INTRINSIC_OR;
where = gfc_current_locus;
gfc_gobble_whitespace ();
- if (gfc_next_char () == c)
+ if (gfc_next_ascii_char () == c)
return MATCH_YES;
gfc_current_locus = where;
}
default:
- if (c == gfc_next_char ())
+ if (c == gfc_next_ascii_char ())
goto loop;
break;
}
gfc_expr *e;
match m;
gfc_compile_state s;
- int c;
e = NULL;
if (gfc_match_eos () == MATCH_YES)
RETURN keyword:
return+1
return(1) */
- c = gfc_peek_char ();
+ char c = gfc_peek_ascii_char ();
if (ISALPHA (c) || ISDIGIT (c))
return MATCH_NO;
}
gfc_gobble_whitespace ();
if (gfc_match_eos () == MATCH_YES)
goto done;
- if (gfc_peek_char () == '/')
+ if (gfc_peek_ascii_char () == '/')
break;
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
gfc_gobble_whitespace ();
- if (gfc_peek_char () == '/')
+ if (gfc_peek_ascii_char () == '/')
break;
}
}
/* match.c. */
/* Generic match subroutines. */
-match gfc_match_special_char (int *);
+match gfc_match_special_char (gfc_char_t *);
match gfc_match_space (void);
match gfc_match_eos (void);
match gfc_match_small_literal_int (int *, int *);
gfc_match_omp_eos (void)
{
locus old_loc;
- int c;
+ char c;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
switch (c)
{
case '!':
do
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
while (c != '\n');
/* Fall through */
{
gfc_statement st;
locus old_locus;
- int c;
+ char c;
if (gfc_match_eos () == MATCH_YES)
return ST_NONE;
statement, we eliminate most possibilities by peeking at the
first character. */
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
switch (c)
{
gfc_statement st;
locus old_locus;
match m;
- int c;
+ char c;
#ifdef GFC_DEBUG
gfc_symbol_state ();
statement, we eliminate most possibilities by peeking at the
first character. */
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
switch (c)
{
decode_omp_directive (void)
{
locus old_locus;
- int c;
+ char c;
#ifdef GFC_DEBUG
gfc_symbol_state ();
statement, we eliminate most possibilities by peeking at the
first character. */
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
switch (c)
{
next_free (void)
{
match m;
- int c, d, cnt, at_bol;
+ int i, cnt, at_bol;
+ char c;
at_bol = gfc_at_bol ();
gfc_gobble_whitespace ();
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
if (ISDIGIT (c))
{
+ char d;
+
/* Found a statement label? */
m = gfc_match_st_label (&gfc_statement_label);
- d = gfc_peek_char ();
+ d = gfc_peek_ascii_char ();
if (m != MATCH_YES || !gfc_is_whitespace (d))
{
- gfc_match_small_literal_int (&c, &cnt);
+ gfc_match_small_literal_int (&i, &cnt);
if (cnt > 5)
gfc_error_now ("Too many digits in statement label at %C");
- if (c == 0)
+ if (i == 0)
gfc_error_now ("Zero is not a valid statement label at %C");
do
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
while (ISDIGIT(c));
if (!gfc_is_whitespace (c))
gfc_gobble_whitespace ();
- if (at_bol && gfc_peek_char () == ';')
+ if (at_bol && gfc_peek_ascii_char () == ';')
{
gfc_error_now ("Semicolon at %C needs to be preceded by "
"statement");
- gfc_next_char (); /* Eat up the semicolon. */
+ gfc_next_ascii_char (); /* Eat up the semicolon. */
return ST_NONE;
}
{
int i;
- c = gfc_next_char ();
- for (i = 0; i < 5; i++, c = gfc_next_char ())
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < 5; i++, c = gfc_next_ascii_char ())
gcc_assert (c == "!$omp"[i]);
gcc_assert (c == ' ');
if (at_bol && c == ';')
{
gfc_error_now ("Semicolon at %C needs to be preceded by statement");
- gfc_next_char (); /* Eat up the semicolon. */
+ gfc_next_ascii_char (); /* Eat up the semicolon. */
return ST_NONE;
}
{
int label, digit_flag, i;
locus loc;
- char c;
+ gfc_char_t c;
if (!gfc_at_bol ())
return decode_statement ();
case '7':
case '8':
case '9':
- label = label * 10 + c - '0';
+ label = label * 10 + ((unsigned char) c - '0');
label_locus = gfc_current_locus;
digit_flag = 1;
break;
if (gfc_option.flag_openmp)
{
for (i = 0; i < 5; i++, c = gfc_next_char_literal (0))
- gcc_assert (TOLOWER (c) == "*$omp"[i]);
+ gcc_assert ((char) gfc_wide_tolower (c) == "*$omp"[i]);
if (c != ' ' && c != '0')
{
#include "arith.h"
#include "match.h"
#include "parse.h"
+#include "toplev.h"
/* Matches a kind-parameter expression, which is either a named
symbolic constant or a nonnegative integer constant. If
/* Given a character and a radix, see if the character is a valid
digit in that radix. */
-static int
-check_digit (int c, int radix)
+int
+gfc_check_digit (char c, int radix)
{
int r;
break;
default:
- gfc_internal_error ("check_digit(): bad radix");
+ gfc_internal_error ("gfc_check_digit(): bad radix");
}
return r;
match_digits (int signflag, int radix, char *buffer)
{
locus old_loc;
- int length, c;
+ int length;
+ char c;
length = 0;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (signflag && (c == '+' || c == '-'))
{
if (buffer != NULL)
*buffer++ = c;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
length++;
}
- if (!check_digit (c, radix))
+ if (!gfc_check_digit (c, radix))
return -1;
length++;
for (;;)
{
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
- if (!check_digit (c, radix))
+ if (!gfc_check_digit (c, radix))
break;
if (buffer != NULL)
&gfc_current_locus);
e->representation.string = gfc_getmem (num + 1);
+
+ /* FIXME -- determine what should be done for wide character
+ strings, and do it! */
for (i = 0; i < num; i++)
- {
- e->representation.string[i] = gfc_next_char_literal (1);
- }
+ e->representation.string[i]
+ = (unsigned char) gfc_next_char_literal (1);
+
e->representation.string[num] = '\0';
e->representation.length = num;
static match
match_boz_constant (gfc_expr **result)
{
- int post, radix, delim, length, x_hex, kind;
+ int radix, length, x_hex, kind;
locus old_loc, start_loc;
- char *buffer;
+ char *buffer, post, delim;
gfc_expr *e;
start_loc = old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
x_hex = 0;
- switch (post = gfc_next_char ())
+ switch (post = gfc_next_ascii_char ())
{
case 'b':
radix = 2;
/* No whitespace allowed here. */
if (post == 0)
- delim = gfc_next_char ();
+ delim = gfc_next_ascii_char ();
if (delim != '\'' && delim != '\"')
goto backup;
return MATCH_ERROR;
}
- if (gfc_next_char () != delim)
+ if (gfc_next_ascii_char () != delim)
{
gfc_error ("Illegal character in BOZ constant at %C");
return MATCH_ERROR;
if (post == 1)
{
- switch (gfc_next_char ())
+ switch (gfc_next_ascii_char ())
{
case 'b':
radix = 2;
memset (buffer, '\0', length + 1);
match_digits (0, radix, buffer);
- gfc_next_char (); /* Eat delimiter. */
+ gfc_next_ascii_char (); /* Eat delimiter. */
if (post == 1)
- gfc_next_char (); /* Eat postfixed b, o, z, or x. */
+ gfc_next_ascii_char (); /* Eat postfixed b, o, z, or x. */
/* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find
"If a data-stmt-constant is a boz-literal-constant, the corresponding
static match
match_real_constant (gfc_expr **result, int signflag)
{
- int kind, c, count, seen_dp, seen_digits, exp_char;
+ int kind, count, seen_dp, seen_digits;
locus old_loc, temp_loc;
- char *p, *buffer;
+ char *p, *buffer, c, exp_char;
gfc_expr *e;
bool negate;
exp_char = ' ';
negate = FALSE;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (signflag && (c == '+' || c == '-'))
{
if (c == '-')
negate = TRUE;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
/* Scan significand. */
- for (;; c = gfc_next_char (), count++)
+ for (;; c = gfc_next_ascii_char (), count++)
{
if (c == '.')
{
/* Check to see if "." goes with a following operator like
".eq.". */
temp_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (c == 'e' || c == 'd' || c == 'q')
{
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (c == '.')
goto done; /* Operator named .e. or .d. */
}
exp_char = c;
/* Scan exponent. */
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
count++;
if (c == '+' || c == '-')
{ /* optional sign */
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
count++;
}
while (ISDIGIT (c))
{
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
count++;
}
memset (buffer, '\0', count + 1);
p = buffer;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (c == '+' || c == '-')
{
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
/* Hack for mpfr_set_str(). */
if (--count == 0)
break;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
kind = get_kind ();
return doubled delimiters on the input as a single instance of
the delimiter.
- Special return values are:
+ Special return values for "ret" argument are:
-1 End of the string, as determined by the delimiter
-2 Unterminated string detected
Backslash codes are also expanded at this time. */
-static int
-next_string_char (char delimiter)
+static gfc_char_t
+next_string_char (gfc_char_t delimiter, int *ret)
{
locus old_locus;
- int c;
+ gfc_char_t c;
c = gfc_next_char_literal (1);
+ *ret = 0;
if (c == '\n')
- return -2;
+ {
+ *ret = -2;
+ return 0;
+ }
if (gfc_option.flag_backslash && c == '\\')
{
return c;
gfc_current_locus = old_locus;
- return -1;
+ *ret = -1;
+ return 0;
}
int len;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!ISALPHA (c))
return MATCH_NO;
for (;;)
{
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (c == '_')
{
- peek = gfc_peek_char ();
+ peek = gfc_peek_ascii_char ();
if (peek == '\'' || peek == '\"')
{
static match
match_string_constant (gfc_expr **result)
{
- char *p, name[GFC_MAX_SYMBOL_LEN + 1];
- int i, c, kind, length, delimiter, warn_ampersand;
+ char *p, name[GFC_MAX_SYMBOL_LEN + 1], peek;
+ int i, kind, length, warn_ampersand, ret;
locus old_locus, start_locus;
gfc_symbol *sym;
gfc_expr *e;
const char *q;
match m;
+ gfc_char_t c, delimiter;
old_locus = gfc_current_locus;
goto got_delim;
}
- if (ISDIGIT (c))
+ if (gfc_wide_is_digit (c))
{
kind = 0;
- while (ISDIGIT (c))
+ while (gfc_wide_is_digit (c))
{
kind = kind * 10 + c - '0';
if (kind > 9999999)
for (;;)
{
- c = next_string_char (delimiter);
- if (c == -1)
+ c = next_string_char (delimiter, &ret);
+ if (ret == -1)
break;
- if (c == -2)
+ if (ret == -2)
{
gfc_current_locus = start_locus;
gfc_error ("Unterminated character constant beginning at %C");
/* Peek at the next character to see if it is a b, o, z, or x for the
postfixed BOZ literal constants. */
- c = gfc_peek_char ();
- if (c == 'b' || c == 'o' || c =='z' || c == 'x')
+ peek = gfc_peek_ascii_char ();
+ if (peek == 'b' || peek == 'o' || peek =='z' || peek == 'x')
goto no_match;
gfc_option.warn_ampersand = 0;
for (i = 0; i < length; i++)
- *p++ = next_string_char (delimiter);
+ {
+ c = next_string_char (delimiter, &ret);
+
+ if (!gfc_wide_fits_in_byte (c))
+ {
+ gfc_error ("Unimplemented feature at %C: gfortran currently only "
+ "supports character strings with one-byte characters");
+ return MATCH_ERROR;
+ }
+
+ *p++ = (unsigned char) c;
+ }
*p = '\0'; /* TODO: C-style string is for development/debug purposes. */
gfc_option.warn_ampersand = warn_ampersand;
- if (next_string_char (delimiter) != -1)
+ next_string_char (delimiter, &ret);
+ if (ret != -1)
gfc_internal_error ("match_string_constant(): Delimiter not found");
if (match_substring (NULL, 0, &e->ref) != MATCH_NO)
locus orig_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
- int ch = gfc_next_char();
+ char ch = gfc_next_ascii_char ();
if (ch == 'f')
{
- if (gfc_next_char () == 'a'
- && gfc_next_char () == 'l'
- && gfc_next_char () == 's'
- && gfc_next_char () == 'e'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'a'
+ && gfc_next_ascii_char () == 'l'
+ && gfc_next_ascii_char () == 's'
+ && gfc_next_ascii_char () == 'e'
+ && gfc_next_ascii_char () == '.')
/* Matched ".false.". */
return 0;
}
else if (ch == 't')
{
- if (gfc_next_char () == 'r'
- && gfc_next_char () == 'u'
- && gfc_next_char () == 'e'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'r'
+ && gfc_next_ascii_char () == 'u'
+ && gfc_next_ascii_char () == 'e'
+ && gfc_next_ascii_char () == '.')
/* Matched ".true.". */
return 1;
}
{
/* Give the matcher for implied do-loops a chance to run. This
yields a much saner error message for (/ (i, 4=i, 6) /). */
- if (gfc_peek_char () == '=')
+ if (gfc_peek_ascii_char () == '=')
{
m = MATCH_ERROR;
goto cleanup;
gfc_symtree *symtree;
locus where, w;
gfc_expr *e;
- int c;
+ char c;
where = gfc_current_locus;
case MATCH_YES:
w = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
gfc_current_locus = w;
if (c != ',' && c != ')')
tail = NULL;
gfc_gobble_whitespace ();
- if ((equiv_flag && gfc_peek_char () == '(') || sym->attr.dimension)
+ if ((equiv_flag && gfc_peek_ascii_char () == '(') || sym->attr.dimension)
{
/* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character
return m;
gfc_gobble_whitespace ();
- if (equiv_flag && gfc_peek_char () == '(')
+ if (equiv_flag && gfc_peek_ascii_char () == '(')
{
tail = extend_ref (primary, tail);
tail->type = REF_ARRAY;
/* See if this is a directly recursive function call. */
gfc_gobble_whitespace ();
if (sym->attr.recursive
- && gfc_peek_char () == '('
+ && gfc_peek_ascii_char () == '('
&& gfc_current_ns->proc_name == sym
&& !sym->attr.dimension)
{
{
case FL_VARIABLE:
variable:
- if (sym->ts.type == BT_UNKNOWN && gfc_peek_char () == '%'
+ if (sym->ts.type == BT_UNKNOWN && gfc_peek_ascii_char () == '%'
&& gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns);
via an IMPLICIT statement. This can't wait for the
resolution phase. */
- if (gfc_peek_char () == '%'
+ if (gfc_peek_ascii_char () == '%'
&& sym->ts.type == BT_UNKNOWN
&& gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns);
variable is just a scalar. */
gfc_gobble_whitespace ();
- if (gfc_peek_char () != '(')
+ if (gfc_peek_ascii_char () != '(')
{
/* Assume a scalar variable */
e = gfc_get_expr ();
break;
/* These are definitive indicators that this is a variable. */
- else if (gfc_peek_char () != '(' || sym->ts.type != BT_UNKNOWN
+ else if (gfc_peek_ascii_char () != '(' || sym->ts.type != BT_UNKNOWN
|| sym->attr.pointer || sym->as != NULL)
flavor = FL_VARIABLE;
else
implicit_ns = sym->ns;
- if (gfc_peek_char () == '%'
+ if (gfc_peek_ascii_char () == '%'
&& sym->ts.type == BT_UNKNOWN
&& gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, implicit_ns);
locus gfc_current_locus;
const char *gfc_source_file;
static FILE *gfc_src_file;
-static char *gfc_src_preprocessor_lines[2];
+static gfc_char_t *gfc_src_preprocessor_lines[2];
extern int pedantic;
size_t file_changes_cur, file_changes_count;
size_t file_changes_allocated;
+
+/* Functions dealing with our wide characters (gfc_char_t) and
+ sequences of such characters. */
+
+int
+gfc_wide_fits_in_byte (gfc_char_t c)
+{
+ return (c <= UCHAR_MAX);
+}
+
+static inline int
+wide_is_ascii (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
+}
+
+int
+gfc_wide_is_printable (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
+}
+
+gfc_char_t
+gfc_wide_tolower (gfc_char_t c)
+{
+ return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
+}
+
+int
+gfc_wide_is_digit (gfc_char_t c)
+{
+ return (c >= '0' && c <= '9');
+}
+
+static inline int
+wide_atoi (gfc_char_t *c)
+{
+#define MAX_DIGITS 20
+ char buf[MAX_DIGITS+1];
+ int i = 0;
+
+ while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
+ buf[i++] = *c++;
+ buf[i] = '\0';
+ return atoi (buf);
+}
+
+size_t
+gfc_wide_strlen (const gfc_char_t *str)
+{
+ size_t i;
+
+ for (i = 0; str[i]; i++)
+ ;
+
+ return i;
+}
+
+static gfc_char_t *
+wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
+{
+ gfc_char_t *d;
+
+ for (d = dest; (*d = *src) != '\0'; ++src, ++d)
+ ;
+
+ return dest;
+}
+
+static gfc_char_t *
+wide_strchr (gfc_char_t *s, gfc_char_t c)
+{
+ do {
+ if (*s == c)
+ {
+ return (gfc_char_t *) s;
+ }
+ } while (*s++);
+ return 0;
+}
+
+static char *
+widechar_to_char (gfc_char_t *s)
+{
+ size_t len = gfc_wide_strlen (s), i;
+ char *res = gfc_getmem (len + 1);
+
+ for (i = 0; i < len; i++)
+ res[i] = gfc_wide_fits_in_byte (s[i]) ? (unsigned char) s[i] : '?';
+
+ res[len] = '\0';
+ return res;
+}
+
+static int
+wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = *s1++;
+ c2 = *s2++;
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
+
+static int
+wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = gfc_wide_tolower (*s1++);
+ c2 = TOLOWER (*s2++);
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
+
+
/* Main scanner initialization. */
void
pointer from being on the wrong line if the current statement ends
prematurely. */
-static int
+static gfc_char_t
next_char (void)
{
- int c;
+ gfc_char_t c;
if (gfc_current_locus.nextc == NULL)
return '\n';
- c = (unsigned char) *gfc_current_locus.nextc++;
+ c = *gfc_current_locus.nextc++;
if (c == '\0')
{
gfc_current_locus.nextc--; /* Remain on this line. */
static void
skip_comment_line (void)
{
- char c;
+ gfc_char_t c;
do
{
int
gfc_define_undef_line (void)
{
+ char *tmp;
+
/* All lines beginning with '#' are either #define or #undef. */
- if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_char () != '#')
+ if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
return 0;
- if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
- (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
- &(gfc_current_locus.nextc[8]));
+ if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
+ {
+ tmp = widechar_to_char (&gfc_current_locus.nextc[8]);
+ (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
- if (strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
- (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
- &(gfc_current_locus.nextc[7]));
+ if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
+ {
+ tmp = widechar_to_char (&gfc_current_locus.nextc[7]);
+ (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
/* Skip the rest of the line. */
skip_comment_line ();
skip_free_comments (void)
{
locus start;
- char c;
+ gfc_char_t c;
int at_bol;
for (;;)
{
locus start;
int col;
- char c;
+ gfc_char_t c;
if (! gfc_at_bol ())
{
line. The in_string flag denotes whether we're inside a character
context or not. */
-int
+gfc_char_t
gfc_next_char_literal (int in_string)
{
locus old_loc;
- int i, c, prev_openmp_flag;
+ int i, prev_openmp_flag;
+ gfc_char_t c;
continue_flag = 0;
{
for (i = 0; i < 5; i++, c = next_char ())
{
- gcc_assert (TOLOWER (c) == "!$omp"[i]);
+ gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
if (i == 4)
old_loc = gfc_current_locus;
}
for (i = 0; i < 5; i++)
{
c = next_char ();
- if (TOLOWER (c) != "*$omp"[i])
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
parsing character literals, they have to call
gfc_next_char_literal(). */
-int
+gfc_char_t
gfc_next_char (void)
{
- int c;
+ gfc_char_t c;
do
{
}
while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
- return TOLOWER (c);
+ return gfc_wide_tolower (c);
}
+char
+gfc_next_ascii_char (void)
+{
+ gfc_char_t c = gfc_next_char ();
-int
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
+gfc_char_t
gfc_peek_char (void)
{
locus old_loc;
- int c;
+ gfc_char_t c;
old_loc = gfc_current_locus;
c = gfc_next_char ();
}
+char
+gfc_peek_ascii_char (void)
+{
+ gfc_char_t c = gfc_peek_char ();
+
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
/* Recover from an error. We try to get past the current statement
and get lined up for the next. The next statement follows a '\n'
or a ';'. We also assume that we are not within a character
void
gfc_error_recovery (void)
{
- char c, delim;
+ gfc_char_t c, delim;
if (gfc_at_eof ())
return;
{
static int linenum = 0;
locus old_loc;
- int c;
+ gfc_char_t c;
do
{
parts of gfortran. */
static int
-load_line (FILE *input, char **pbuf, int *pbuflen)
+load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
{
static int linenum = 0, current_line = 1;
int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0, seen_comment = 0;
int seen_printable = 0, seen_ampersand = 0;
- char *buffer;
+ gfc_char_t *buffer;
bool found_tab = false;
/* Determine the maximum allowed line length. */
else
buflen = 132;
- *pbuf = gfc_getmem (buflen + 1);
+ *pbuf = gfc_getmem ((buflen + 1) * sizeof (gfc_char_t));
}
i = 0;
/* Reallocate line buffer to double size to hold the
overlong line. */
buflen = buflen * 2;
- *pbuf = xrealloc (*pbuf, buflen + 1);
+ *pbuf = xrealloc (*pbuf, (buflen + 1) * sizeof (gfc_char_t));
buffer = (*pbuf) + i;
}
}
return f;
}
+
/* Deal with a line from the C preprocessor. The
initial octothorp has already been seen. */
static void
-preprocessor_line (char *c)
+preprocessor_line (gfc_char_t *c)
{
bool flag[5];
int i, line;
- char *filename;
+ gfc_char_t *wide_filename;
gfc_file *f;
int escaped, unescape;
+ char *filename;
c++;
while (*c == ' ' || *c == '\t')
if (*c < '0' || *c > '9')
goto bad_cpp_line;
- line = atoi (c);
+ line = wide_atoi (c);
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
{
/* No file name given. Set new line number. */
goto bad_cpp_line;
++c;
- filename = c;
+ wide_filename = c;
/* Make filename end at quote. */
unescape = 0;
/* Undo effects of cpp_quote_string. */
if (unescape)
{
- char *s = filename;
- char *d = gfc_getmem (c - filename - unescape);
+ gfc_char_t *s = wide_filename;
+ gfc_char_t *d = gfc_getmem (c - wide_filename - unescape);
- filename = d;
+ wide_filename = d;
while (*s)
{
if (*s == '\\')
for (;;)
{
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
break;
c++;
- i = atoi (c);
+ i = wide_atoi (c);
if (1 <= i && i <= 4)
flag[i] = true;
}
+ /* Convert the filename in wide characters into a filename in narrow
+ characters. */
+ filename = widechar_to_char (wide_filename);
+
/* Interpret flags. */
if (flag[1]) /* Starting new file. */
current_file->filename, current_file->line,
filename);
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
}
/* Set new line number. */
current_file->line = line;
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
bad_cpp_line:
processed or true if we matched an include. */
static bool
-include_line (char *line)
+include_line (gfc_char_t *line)
{
- char quote, *c, *begin, *stop;
+ gfc_char_t quote, *c, *begin, *stop;
+ char *filename;
c = line;
while (*c == ' ' || *c == '\t')
c++;
- if (strncasecmp (c, "include", 7))
- return false;
+ if (wide_strncasecmp (c, "include", 7))
+ return false;
c += 7;
while (*c == ' ' || *c == '\t')
*stop = '\0'; /* It's ok to trash the buffer, as this line won't be
read by anything else. */
- load_file (begin, false);
+ filename = widechar_to_char (begin);
+ load_file (filename, false);
+ gfc_free (filename);
return true;
}
static try
load_file (const char *filename, bool initial)
{
- char *line;
+ gfc_char_t *line;
gfc_linebuf *b;
gfc_file *f;
FILE *input;
{
int trunc = load_line (input, &line, &line_len);
- len = strlen (line);
+ len = gfc_wide_strlen (line);
if (feof (input) && len == 0)
break;
FE FF is UTF-16 big endian,
EF BB BF is UTF-8. */
if (first_line
- && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
- || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
- || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
- && line[2] == '\xBF')))
+ && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
+ && line[1] == (unsigned char) '\xFE')
+ || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
+ && line[1] == (unsigned char) '\xFF')
+ || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
+ && line[1] == (unsigned char) '\xBB'
+ && line[2] == (unsigned char) '\xBF')))
{
- int n = line[1] == '\xBB' ? 3 : 2;
- char * new = gfc_getmem (line_len);
+ int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
+ gfc_char_t *new = gfc_getmem (line_len * sizeof (gfc_char_t));
- strcpy (new, line + n);
+ wide_strcpy (new, &line[n]);
gfc_free (line);
line = new;
len -= n;
and #undef lines, which we need to pass to the middle-end
so that it can emit correct debug info. */
if (debug_info_level == DINFO_LEVEL_VERBOSE
- && (strncmp (line, "#define ", 8) == 0
- || strncmp (line, "#undef ", 7) == 0))
+ && (wide_strncmp (line, "#define ", 8) == 0
+ || wide_strncmp (line, "#undef ", 7) == 0))
;
else
{
/* Add line. */
- b = gfc_getmem (gfc_linebuf_header_size + len + 1);
+ b = gfc_getmem (gfc_linebuf_header_size
+ + (len + 1) * sizeof (gfc_char_t));
b->location
= linemap_line_start (line_table, current_file->line++, 120);
b->file = current_file;
b->truncated = trunc;
- strcpy (b->line, line);
+ wide_strcpy (b->line, line);
if (line_head == NULL)
line_head = b;
gfc_read_orig_filename (const char *filename, const char **canon_source_file)
{
int c, len;
- char *dirname;
+ char *dirname, *tmp;
gfc_src_file = gfc_open_file (filename);
if (gfc_src_file == NULL)
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
- if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
return NULL;
- filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
+ tmp = widechar_to_char (&gfc_src_preprocessor_lines[0][5]);
+ filename = unescape_filename (tmp);
+ gfc_free (tmp);
if (filename == NULL)
return NULL;
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
- if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
return filename;
- dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
+ tmp = widechar_to_char (&gfc_src_preprocessor_lines[1][5]);
+ dirname = unescape_filename (tmp);
+ gfc_free (tmp);
if (dirname == NULL)
return filename;
OSDN Git Service
