Commit 8fc541d3 by Francois-Xavier Coudert Committed by François-Xavier Coudert

openmp.c (gfc_match_omp_eos): Use gfc_next_ascii_char and gfc_peek_ascii_char.

	* 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.

From-SVN: r134992
parent d0b48c67
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> 2008-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/36117 PR fortran/36117
......
...@@ -1940,7 +1940,8 @@ kind_expr: ...@@ -1940,7 +1940,8 @@ kind_expr:
} }
gfc_gobble_whitespace (); 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) if (ts->type == BT_CHARACTER)
gfc_error ("Missing right parenthesis or comma at %C"); gfc_error ("Missing right parenthesis or comma at %C");
...@@ -2213,7 +2214,7 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag) ...@@ -2213,7 +2214,7 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag)
char name[GFC_MAX_SYMBOL_LEN + 1]; char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym; gfc_symbol *sym;
match m; match m;
int c; char c;
bool seen_deferred_kind; bool seen_deferred_kind;
/* A belt and braces check that the typespec is correctly being treated /* A belt and braces check that the typespec is correctly being treated
...@@ -2360,7 +2361,7 @@ get_kind: ...@@ -2360,7 +2361,7 @@ get_kind:
if (gfc_current_form == FORM_FREE) if (gfc_current_form == FORM_FREE)
{ {
c = gfc_peek_char(); c = gfc_peek_ascii_char();
if (!gfc_is_whitespace(c) && c != '*' && c != '(' if (!gfc_is_whitespace(c) && c != '*' && c != '('
&& c != ':' && c != ',') && c != ':' && c != ',')
return MATCH_NO; return MATCH_NO;
...@@ -2400,13 +2401,14 @@ gfc_match_implicit_none (void) ...@@ -2400,13 +2401,14 @@ gfc_match_implicit_none (void)
static match static match
match_implicit_range (void) match_implicit_range (void)
{ {
int c, c1, c2, inner; char c, c1, c2;
int inner;
locus cur_loc; locus cur_loc;
cur_loc = gfc_current_locus; cur_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (c != '(') if (c != '(')
{ {
gfc_error ("Missing character range in IMPLICIT at %C"); gfc_error ("Missing character range in IMPLICIT at %C");
...@@ -2417,12 +2419,12 @@ match_implicit_range (void) ...@@ -2417,12 +2419,12 @@ match_implicit_range (void)
while (inner) while (inner)
{ {
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c1 = gfc_next_char (); c1 = gfc_next_ascii_char ();
if (!ISALPHA (c1)) if (!ISALPHA (c1))
goto bad; goto bad;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
switch (c) switch (c)
{ {
...@@ -2435,12 +2437,12 @@ match_implicit_range (void) ...@@ -2435,12 +2437,12 @@ match_implicit_range (void)
case '-': case '-':
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c2 = gfc_next_char (); c2 = gfc_next_ascii_char ();
if (!ISALPHA (c2)) if (!ISALPHA (c2))
goto bad; goto bad;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if ((c != ',') && (c != ')')) if ((c != ',') && (c != ')'))
goto bad; goto bad;
...@@ -2503,7 +2505,7 @@ gfc_match_implicit (void) ...@@ -2503,7 +2505,7 @@ gfc_match_implicit (void)
{ {
gfc_typespec ts; gfc_typespec ts;
locus cur_loc; locus cur_loc;
int c; char c;
match m; match m;
gfc_clear_ts (&ts); gfc_clear_ts (&ts);
...@@ -2534,7 +2536,7 @@ gfc_match_implicit (void) ...@@ -2534,7 +2536,7 @@ gfc_match_implicit (void)
{ {
/* We may have <TYPE> (<RANGE>). */ /* We may have <TYPE> (<RANGE>). */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if ((c == '\n') || (c == ',')) if ((c == '\n') || (c == ','))
{ {
/* Check for CHARACTER with no length parameter. */ /* Check for CHARACTER with no length parameter. */
...@@ -2584,7 +2586,7 @@ gfc_match_implicit (void) ...@@ -2584,7 +2586,7 @@ gfc_match_implicit (void)
goto syntax; goto syntax;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if ((c != '\n') && (c != ',')) if ((c != '\n') && (c != ','))
goto syntax; goto syntax;
...@@ -2713,7 +2715,7 @@ match_string_p (const char *target) ...@@ -2713,7 +2715,7 @@ match_string_p (const char *target)
const char *p; const char *p;
for (p = target; *p; p++) for (p = target; *p; p++)
if (gfc_next_char () != *p) if ((char) gfc_next_ascii_char () != *p)
return false; return false;
return true; return true;
} }
...@@ -2765,22 +2767,22 @@ match_attr_spec (void) ...@@ -2765,22 +2767,22 @@ match_attr_spec (void)
for (;;) for (;;)
{ {
int ch; char ch;
d = DECL_NONE; d = DECL_NONE;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == ':') if (ch == ':')
{ {
/* This is the successful exit condition for the loop. */ /* This is the successful exit condition for the loop. */
if (gfc_next_char () == ':') if (gfc_next_ascii_char () == ':')
break; break;
} }
else if (ch == ',') else if (ch == ',')
{ {
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
switch (gfc_peek_char ()) switch (gfc_peek_ascii_char ())
{ {
case 'a': case 'a':
if (match_string_p ("allocatable")) if (match_string_p ("allocatable"))
...@@ -2809,7 +2811,7 @@ match_attr_spec (void) ...@@ -2809,7 +2811,7 @@ match_attr_spec (void)
case 'i': case 'i':
if (match_string_p ("int")) if (match_string_p ("int"))
{ {
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'e') if (ch == 'e')
{ {
if (match_string_p ("nt")) if (match_string_p ("nt"))
...@@ -2841,8 +2843,8 @@ match_attr_spec (void) ...@@ -2841,8 +2843,8 @@ match_attr_spec (void)
break; break;
case 'p': case 'p':
gfc_next_char (); gfc_next_ascii_char ();
switch (gfc_next_char ()) switch (gfc_next_ascii_char ())
{ {
case 'a': case 'a':
if (match_string_p ("rameter")) if (match_string_p ("rameter"))
...@@ -2861,7 +2863,7 @@ match_attr_spec (void) ...@@ -2861,7 +2863,7 @@ match_attr_spec (void)
break; break;
case 'r': case 'r':
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'i') if (ch == 'i')
{ {
if (match_string_p ("vate")) if (match_string_p ("vate"))
...@@ -2901,8 +2903,8 @@ match_attr_spec (void) ...@@ -2901,8 +2903,8 @@ match_attr_spec (void)
break; break;
case 'v': case 'v':
gfc_next_char (); gfc_next_ascii_char ();
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'a') if (ch == 'a')
{ {
if (match_string_p ("lue")) if (match_string_p ("lue"))
...@@ -3938,7 +3940,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) ...@@ -3938,7 +3940,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
match is_bind_c; /* Found bind(c). */ match is_bind_c; /* Found bind(c). */
match is_result; /* Found result clause. */ match is_result; /* Found result clause. */
match found_match; /* Status of whether we've found a good match. */ 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; bool allow_binding_name;
/* Initialize to having found nothing. */ /* Initialize to having found nothing. */
...@@ -3948,7 +3950,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) ...@@ -3948,7 +3950,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
/* Get the next char to narrow between result and bind(c). */ /* Get the next char to narrow between result and bind(c). */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
peek_char = gfc_peek_char (); peek_char = gfc_peek_ascii_char ();
/* C binding names are not allowed for internal procedures. */ /* C binding names are not allowed for internal procedures. */
if (gfc_current_state () == COMP_CONTAINS if (gfc_current_state () == COMP_CONTAINS
...@@ -4037,7 +4039,7 @@ match_procedure_decl (void) ...@@ -4037,7 +4039,7 @@ match_procedure_decl (void)
/* Get the type spec. for the procedure interface. */ /* Get the type spec. for the procedure interface. */
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
m = gfc_match_type_spec (&current_ts, 0); m = gfc_match_type_spec (&current_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; goto got_ts;
if (m == MATCH_ERROR) if (m == MATCH_ERROR)
...@@ -4530,7 +4532,7 @@ gfc_match_entry (void) ...@@ -4530,7 +4532,7 @@ gfc_match_entry (void)
/* Check what next non-whitespace character is so we can tell if there /* Check what next non-whitespace character is so we can tell if there
is the required parens if we have a BIND(C). */ is the required parens if we have a BIND(C). */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
peek_char = gfc_peek_char (); peek_char = gfc_peek_ascii_char ();
if (state == COMP_SUBROUTINE) if (state == COMP_SUBROUTINE)
{ {
...@@ -4686,7 +4688,7 @@ gfc_match_subroutine (void) ...@@ -4686,7 +4688,7 @@ gfc_match_subroutine (void)
/* Check what next non-whitespace character is so we can tell if there /* Check what next non-whitespace character is so we can tell if there
is the required parens if we have a BIND(C). */ is the required parens if we have a BIND(C). */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
peek_char = gfc_peek_char (); peek_char = gfc_peek_ascii_char ();
if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
return MATCH_ERROR; return MATCH_ERROR;
...@@ -5486,7 +5488,7 @@ match ...@@ -5486,7 +5488,7 @@ match
gfc_match_pointer (void) gfc_match_pointer (void)
{ {
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (gfc_peek_char () == '(') if (gfc_peek_ascii_char () == '(')
{ {
if (!gfc_option.flag_cray_pointer) if (!gfc_option.flag_cray_pointer)
{ {
......
...@@ -156,6 +156,66 @@ error_integer (long int i) ...@@ -156,6 +156,66 @@ error_integer (long int i)
locus. Calls error_printf() recursively, but the recursion is at locus. Calls error_printf() recursively, but the recursion is at
most one level deep. */ 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 error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
static void static void
...@@ -163,8 +223,8 @@ show_locus (locus *loc, int c1, int c2) ...@@ -163,8 +223,8 @@ show_locus (locus *loc, int c1, int c2)
{ {
gfc_linebuf *lb; gfc_linebuf *lb;
gfc_file *f; gfc_file *f;
char c, *p; gfc_char_t c, *p;
int i, m, offset, cmax; int i, offset, cmax;
/* TODO: Either limit the total length and number of included files /* TODO: Either limit the total length and number of included files
displayed or add buffering of arbitrary number of characters in displayed or add buffering of arbitrary number of characters in
...@@ -246,8 +306,8 @@ show_locus (locus *loc, int c1, int c2) ...@@ -246,8 +306,8 @@ show_locus (locus *loc, int c1, int c2)
to work correctly when nonprintable characters exist. A better to work correctly when nonprintable characters exist. A better
solution should be found. */ solution should be found. */
p = lb->line + offset; p = &(lb->line[offset]);
i = strlen (p); i = gfc_wide_strlen (p);
if (i > terminal_width) if (i > terminal_width)
i = terminal_width - 1; i = terminal_width - 1;
...@@ -257,23 +317,7 @@ show_locus (locus *loc, int c1, int c2) ...@@ -257,23 +317,7 @@ show_locus (locus *loc, int c1, int c2)
if (c == '\t') if (c == '\t')
c = ' '; c = ' ';
if (ISPRINT (c)) print_wide_char (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);
}
} }
error_char ('\n'); error_char ('\n');
......
...@@ -700,6 +700,21 @@ typedef struct ...@@ -700,6 +700,21 @@ typedef struct
symbol_attribute; 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 following three structures are used to identify a location in
the sources. the sources.
...@@ -729,7 +744,7 @@ typedef struct gfc_linebuf ...@@ -729,7 +744,7 @@ typedef struct gfc_linebuf
int truncated; int truncated;
bool dbg_emitted; bool dbg_emitted;
char line[1]; gfc_char_t line[1];
} gfc_linebuf; } gfc_linebuf;
#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line)) #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
...@@ -738,7 +753,7 @@ typedef struct gfc_linebuf ...@@ -738,7 +753,7 @@ typedef struct gfc_linebuf
typedef struct typedef struct
{ {
char *nextc; gfc_char_t *nextc;
gfc_linebuf *lb; gfc_linebuf *lb;
} locus; } locus;
...@@ -1940,10 +1955,18 @@ void gfc_advance_line (void); ...@@ -1940,10 +1955,18 @@ void gfc_advance_line (void);
int gfc_check_include (void); int gfc_check_include (void);
int gfc_define_undef_line (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); void gfc_skip_comments (void);
int gfc_next_char_literal (int); gfc_char_t gfc_next_char_literal (int);
int gfc_next_char (void); gfc_char_t gfc_next_char (void);
int gfc_peek_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_error_recovery (void);
void gfc_gobble_whitespace (void); void gfc_gobble_whitespace (void);
try gfc_new_file (void); try gfc_new_file (void);
...@@ -2354,6 +2377,7 @@ bool gfc_check_access (gfc_access, gfc_access); ...@@ -2354,6 +2377,7 @@ bool gfc_check_access (gfc_access, gfc_access);
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
symbol_attribute gfc_expr_attr (gfc_expr *); symbol_attribute gfc_expr_attr (gfc_expr *);
match gfc_match_rvalue (gfc_expr **); match gfc_match_rvalue (gfc_expr **);
int gfc_check_digit (char, int);
/* trans.c */ /* trans.c */
void gfc_generate_code (gfc_namespace *); void gfc_generate_code (gfc_namespace *);
......
...@@ -237,13 +237,17 @@ Allow @samp{$} as a valid character in a symbol name. ...@@ -237,13 +237,17 @@ Allow @samp{$} as a valid character in a symbol name.
@opindex @code{backslash} @opindex @code{backslash}
@cindex backslash @cindex backslash
@cindex escape characters @cindex escape characters
Change the interpretation of backslashes in string literals Change the interpretation of backslashes in string literals from a single
from a single backslash character to ``C-style'' escape characters. backslash character to ``C-style'' escape characters. The following
The following combinations are expanded \a, \b, \f, \n, \r, \t, combinations are expanded @code{\a}, @code{\b}, @code{\f}, @code{\n},
\v, \\, and \0 to the ASCII characters alert, backspace, form feed, @code{\r}, @code{\t}, @code{\v}, @code{\\}, and @code{\0} to the ASCII
newline, carriage return, horizontal tab, vertical tab, backslash, characters alert, backspace, form feed, newline, carriage return,
and NUL, respectively. All other combinations of a character preceded horizontal tab, vertical tab, backslash, and NUL, respectively.
by \ are unexpanded. 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 @item -fmodule-private
@opindex @code{fmodule-private} @opindex @code{fmodule-private}
......
...@@ -132,7 +132,7 @@ mode; ...@@ -132,7 +132,7 @@ mode;
static char static char
next_char (int in_string) next_char (int in_string)
{ {
static char c; static gfc_char_t c;
if (use_last_char) if (use_last_char)
{ {
...@@ -153,18 +153,11 @@ next_char (int in_string) ...@@ -153,18 +153,11 @@ next_char (int in_string)
if (gfc_option.flag_backslash && c == '\\') if (gfc_option.flag_backslash && c == '\\')
{ {
int tmp;
locus old_locus = gfc_current_locus; locus old_locus = gfc_current_locus;
/* Use a temp variable to avoid side effects from gfc_match_special_char if (gfc_match_special_char (&c) == MATCH_NO)
since it uses an int * for its argument. */
tmp = (int)c;
if (gfc_match_special_char (&tmp) == MATCH_NO)
gfc_current_locus = old_locus; gfc_current_locus = old_locus;
c = (char)tmp;
if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
gfc_warning ("Extension: backslash character at %C"); gfc_warning ("Extension: backslash character at %C");
} }
...@@ -172,7 +165,7 @@ next_char (int in_string) ...@@ -172,7 +165,7 @@ next_char (int in_string)
if (mode == MODE_COPY) if (mode == MODE_COPY)
*format_string++ = c; *format_string++ = c;
c = TOUPPER (c); c = TOUPPER ((unsigned char) c);
return c; return c;
} }
...@@ -3185,7 +3178,7 @@ match_io (io_kind k) ...@@ -3185,7 +3178,7 @@ match_io (io_kind k)
char name[GFC_MAX_SYMBOL_LEN + 1]; char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_code *io_code; gfc_code *io_code;
gfc_symbol *sym; gfc_symbol *sym;
int comma_flag, c; int comma_flag;
locus where; locus where;
locus spec_end; locus spec_end;
gfc_dt *dt; gfc_dt *dt;
...@@ -3203,7 +3196,7 @@ match_io (io_kind k) ...@@ -3203,7 +3196,7 @@ match_io (io_kind k)
else if (k == M_PRINT) else if (k == M_PRINT)
{ {
/* Treat the non-standard case of PRINT namelist. */ /* 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_match_name (name) == MATCH_YES)
{ {
gfc_find_symbol (name, NULL, 1, &sym); gfc_find_symbol (name, NULL, 1, &sym);
...@@ -3227,7 +3220,7 @@ match_io (io_kind k) ...@@ -3227,7 +3220,7 @@ match_io (io_kind k)
if (gfc_current_form == FORM_FREE) if (gfc_current_form == FORM_FREE)
{ {
c = gfc_peek_char(); char c = gfc_peek_ascii_char ();
if (c != ' ' && c != '*' && c != '\'' && c != '"') if (c != ' ' && c != '*' && c != '\'' && c != '"')
{ {
m = MATCH_NO; m = MATCH_NO;
......
...@@ -111,8 +111,8 @@ match ...@@ -111,8 +111,8 @@ match
gfc_match_parens (void) gfc_match_parens (void)
{ {
locus old_loc, where; locus old_loc, where;
int c, count, instring; int count, instring;
char quote; gfc_char_t c, quote;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
count = 0; count = 0;
...@@ -126,7 +126,7 @@ gfc_match_parens (void) ...@@ -126,7 +126,7 @@ gfc_match_parens (void)
break; break;
if (quote == ' ' && ((c == '\'') || (c == '"'))) if (quote == ' ' && ((c == '\'') || (c == '"')))
{ {
quote = (char) c; quote = c;
instring = 1; instring = 1;
continue; continue;
} }
...@@ -170,42 +170,66 @@ gfc_match_parens (void) ...@@ -170,42 +170,66 @@ gfc_match_parens (void)
escaped by a \ via the -fbackslash option. */ escaped by a \ via the -fbackslash option. */
match 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; match m;
m = MATCH_YES; m = MATCH_YES;
switch (gfc_next_char_literal (1)) switch ((c = gfc_next_char_literal (1)))
{ {
case 'a': case 'a':
*c = '\a'; *res = '\a';
break; break;
case 'b': case 'b':
*c = '\b'; *res = '\b';
break; break;
case 't': case 't':
*c = '\t'; *res = '\t';
break; break;
case 'f': case 'f':
*c = '\f'; *res = '\f';
break; break;
case 'n': case 'n':
*c = '\n'; *res = '\n';
break; break;
case 'r': case 'r':
*c = '\r'; *res = '\r';
break; break;
case 'v': case 'v':
*c = '\v'; *res = '\v';
break; break;
case '\\': case '\\':
*c = '\\'; *res = '\\';
break; break;
case '0': 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; break;
default: default:
/* Unknown backslash codes are simply not expanded. */ /* Unknown backslash codes are simply not expanded. */
m = MATCH_NO; m = MATCH_NO;
...@@ -223,14 +247,14 @@ match ...@@ -223,14 +247,14 @@ match
gfc_match_space (void) gfc_match_space (void)
{ {
locus old_loc; locus old_loc;
int c; char c;
if (gfc_current_form == FORM_FIXED) if (gfc_current_form == FORM_FIXED)
return MATCH_YES; return MATCH_YES;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (!gfc_is_whitespace (c)) if (!gfc_is_whitespace (c))
{ {
gfc_current_locus = old_loc; gfc_current_locus = old_loc;
...@@ -251,7 +275,8 @@ match ...@@ -251,7 +275,8 @@ match
gfc_match_eos (void) gfc_match_eos (void)
{ {
locus old_loc; locus old_loc;
int flag, c; int flag;
char c;
flag = 0; flag = 0;
...@@ -260,13 +285,13 @@ gfc_match_eos (void) ...@@ -260,13 +285,13 @@ gfc_match_eos (void)
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
switch (c) switch (c)
{ {
case '!': case '!':
do do
{ {
c = gfc_next_char (); c = gfc_next_ascii_char ();
} }
while (c != '\n'); while (c != '\n');
...@@ -302,8 +327,9 @@ gfc_match_small_literal_int (int *value, int *cnt) ...@@ -302,8 +327,9 @@ gfc_match_small_literal_int (int *value, int *cnt)
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
*value = -1;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (cnt) if (cnt)
*cnt = 0; *cnt = 0;
...@@ -319,7 +345,7 @@ gfc_match_small_literal_int (int *value, int *cnt) ...@@ -319,7 +345,7 @@ gfc_match_small_literal_int (int *value, int *cnt)
for (;;) for (;;)
{ {
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (!ISDIGIT (c)) if (!ISDIGIT (c))
break; break;
...@@ -488,12 +514,13 @@ match ...@@ -488,12 +514,13 @@ match
gfc_match_name (char *buffer) gfc_match_name (char *buffer)
{ {
locus old_loc; locus old_loc;
int i, c; int i;
char c;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore))) if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore)))
{ {
if (gfc_error_flag_test() == 0 && c != '(') if (gfc_error_flag_test() == 0 && c != '(')
...@@ -515,13 +542,14 @@ gfc_match_name (char *buffer) ...@@ -515,13 +542,14 @@ gfc_match_name (char *buffer)
} }
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_ascii_char ();
} }
while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$')); while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$'));
if (c == '$' && !gfc_option.flag_dollar_ok) 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; return MATCH_ERROR;
} }
...@@ -551,7 +579,7 @@ gfc_match_name_C (char *buffer) ...@@ -551,7 +579,7 @@ gfc_match_name_C (char *buffer)
{ {
locus old_loc; locus old_loc;
int i = 0; int i = 0;
int c; gfc_char_t c;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
...@@ -579,7 +607,9 @@ gfc_match_name_C (char *buffer) ...@@ -579,7 +607,9 @@ gfc_match_name_C (char *buffer)
/* Continue to read valid variable name characters. */ /* Continue to read valid variable name characters. */
do 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 /* C does not define a maximum length of variable names, to my
knowledge, but the compiler typically places a limit on them. knowledge, but the compiler typically places a limit on them.
...@@ -606,7 +636,7 @@ gfc_match_name_C (char *buffer) ...@@ -606,7 +636,7 @@ gfc_match_name_C (char *buffer)
if (c == ' ') if (c == ' ')
{ {
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_peek_char (); c = gfc_peek_ascii_char ();
if (c != '"' && c != '\'') if (c != '"' && c != '\'')
{ {
gfc_error ("Embedded space in NAME= specifier at %C"); gfc_error ("Embedded space in NAME= specifier at %C");
...@@ -679,10 +709,10 @@ match ...@@ -679,10 +709,10 @@ match
gfc_match_intrinsic_op (gfc_intrinsic_op *result) gfc_match_intrinsic_op (gfc_intrinsic_op *result)
{ {
locus orig_loc = gfc_current_locus; locus orig_loc = gfc_current_locus;
int ch; char ch;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
switch (ch) switch (ch)
{ {
case '+': case '+':
...@@ -696,7 +726,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -696,7 +726,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
return MATCH_YES; return MATCH_YES;
case '=': case '=':
if (gfc_next_char () == '=') if (gfc_next_ascii_char () == '=')
{ {
/* Matched "==". */ /* Matched "==". */
*result = INTRINSIC_EQ; *result = INTRINSIC_EQ;
...@@ -705,10 +735,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -705,10 +735,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case '<': case '<':
if (gfc_peek_char () == '=') if (gfc_peek_ascii_char () == '=')
{ {
/* Matched "<=". */ /* Matched "<=". */
gfc_next_char (); gfc_next_ascii_char ();
*result = INTRINSIC_LE; *result = INTRINSIC_LE;
return MATCH_YES; return MATCH_YES;
} }
...@@ -717,10 +747,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -717,10 +747,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
return MATCH_YES; return MATCH_YES;
case '>': case '>':
if (gfc_peek_char () == '=') if (gfc_peek_ascii_char () == '=')
{ {
/* Matched ">=". */ /* Matched ">=". */
gfc_next_char (); gfc_next_ascii_char ();
*result = INTRINSIC_GE; *result = INTRINSIC_GE;
return MATCH_YES; return MATCH_YES;
} }
...@@ -729,10 +759,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -729,10 +759,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
return MATCH_YES; return MATCH_YES;
case '*': case '*':
if (gfc_peek_char () == '*') if (gfc_peek_ascii_char () == '*')
{ {
/* Matched "**". */ /* Matched "**". */
gfc_next_char (); gfc_next_ascii_char ();
*result = INTRINSIC_POWER; *result = INTRINSIC_POWER;
return MATCH_YES; return MATCH_YES;
} }
...@@ -741,18 +771,18 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -741,18 +771,18 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
return MATCH_YES; return MATCH_YES;
case '/': case '/':
ch = gfc_peek_char (); ch = gfc_peek_ascii_char ();
if (ch == '=') if (ch == '=')
{ {
/* Matched "/=". */ /* Matched "/=". */
gfc_next_char (); gfc_next_ascii_char ();
*result = INTRINSIC_NE; *result = INTRINSIC_NE;
return MATCH_YES; return MATCH_YES;
} }
else if (ch == '/') else if (ch == '/')
{ {
/* Matched "//". */ /* Matched "//". */
gfc_next_char (); gfc_next_ascii_char ();
*result = INTRINSIC_CONCAT; *result = INTRINSIC_CONCAT;
return MATCH_YES; return MATCH_YES;
} }
...@@ -761,13 +791,13 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -761,13 +791,13 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
return MATCH_YES; return MATCH_YES;
case '.': case '.':
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
switch (ch) switch (ch)
{ {
case 'a': case 'a':
if (gfc_next_char () == 'n' if (gfc_next_ascii_char () == 'n'
&& gfc_next_char () == 'd' && gfc_next_ascii_char () == 'd'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
{ {
/* Matched ".and.". */ /* Matched ".and.". */
*result = INTRINSIC_AND; *result = INTRINSIC_AND;
...@@ -776,9 +806,9 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -776,9 +806,9 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case 'e': case 'e':
if (gfc_next_char () == 'q') if (gfc_next_ascii_char () == 'q')
{ {
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == '.') if (ch == '.')
{ {
/* Matched ".eq.". */ /* Matched ".eq.". */
...@@ -787,7 +817,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -787,7 +817,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
} }
else if (ch == 'v') else if (ch == 'v')
{ {
if (gfc_next_char () == '.') if (gfc_next_ascii_char () == '.')
{ {
/* Matched ".eqv.". */ /* Matched ".eqv.". */
*result = INTRINSIC_EQV; *result = INTRINSIC_EQV;
...@@ -798,10 +828,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -798,10 +828,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case 'g': case 'g':
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'e') if (ch == 'e')
{ {
if (gfc_next_char () == '.') if (gfc_next_ascii_char () == '.')
{ {
/* Matched ".ge.". */ /* Matched ".ge.". */
*result = INTRINSIC_GE_OS; *result = INTRINSIC_GE_OS;
...@@ -810,7 +840,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -810,7 +840,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
} }
else if (ch == 't') else if (ch == 't')
{ {
if (gfc_next_char () == '.') if (gfc_next_ascii_char () == '.')
{ {
/* Matched ".gt.". */ /* Matched ".gt.". */
*result = INTRINSIC_GT_OS; *result = INTRINSIC_GT_OS;
...@@ -820,10 +850,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -820,10 +850,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case 'l': case 'l':
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'e') if (ch == 'e')
{ {
if (gfc_next_char () == '.') if (gfc_next_ascii_char () == '.')
{ {
/* Matched ".le.". */ /* Matched ".le.". */
*result = INTRINSIC_LE_OS; *result = INTRINSIC_LE_OS;
...@@ -832,7 +862,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -832,7 +862,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
} }
else if (ch == 't') else if (ch == 't')
{ {
if (gfc_next_char () == '.') if (gfc_next_ascii_char () == '.')
{ {
/* Matched ".lt.". */ /* Matched ".lt.". */
*result = INTRINSIC_LT_OS; *result = INTRINSIC_LT_OS;
...@@ -842,10 +872,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -842,10 +872,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case 'n': case 'n':
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == 'e') if (ch == 'e')
{ {
ch = gfc_next_char (); ch = gfc_next_ascii_char ();
if (ch == '.') if (ch == '.')
{ {
/* Matched ".ne.". */ /* Matched ".ne.". */
...@@ -854,8 +884,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -854,8 +884,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
} }
else if (ch == 'q') else if (ch == 'q')
{ {
if (gfc_next_char () == 'v' if (gfc_next_ascii_char () == 'v'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
{ {
/* Matched ".neqv.". */ /* Matched ".neqv.". */
*result = INTRINSIC_NEQV; *result = INTRINSIC_NEQV;
...@@ -865,8 +895,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -865,8 +895,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
} }
else if (ch == 'o') else if (ch == 'o')
{ {
if (gfc_next_char () == 't' if (gfc_next_ascii_char () == 't'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
{ {
/* Matched ".not.". */ /* Matched ".not.". */
*result = INTRINSIC_NOT; *result = INTRINSIC_NOT;
...@@ -876,8 +906,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) ...@@ -876,8 +906,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
break; break;
case 'o': case 'o':
if (gfc_next_char () == 'r' if (gfc_next_ascii_char () == 'r'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
{ {
/* Matched ".or.". */ /* Matched ".or.". */
*result = INTRINSIC_OR; *result = INTRINSIC_OR;
...@@ -1007,7 +1037,7 @@ gfc_match_char (char c) ...@@ -1007,7 +1037,7 @@ gfc_match_char (char c)
where = gfc_current_locus; where = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (gfc_next_char () == c) if (gfc_next_ascii_char () == c)
return MATCH_YES; return MATCH_YES;
gfc_current_locus = where; gfc_current_locus = where;
...@@ -1157,7 +1187,7 @@ loop: ...@@ -1157,7 +1187,7 @@ loop:
} }
default: default:
if (c == gfc_next_char ()) if (c == gfc_next_ascii_char ())
goto loop; goto loop;
break; break;
} }
...@@ -2414,7 +2444,6 @@ gfc_match_return (void) ...@@ -2414,7 +2444,6 @@ gfc_match_return (void)
gfc_expr *e; gfc_expr *e;
match m; match m;
gfc_compile_state s; gfc_compile_state s;
int c;
e = NULL; e = NULL;
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
...@@ -2433,7 +2462,7 @@ gfc_match_return (void) ...@@ -2433,7 +2462,7 @@ gfc_match_return (void)
RETURN keyword: RETURN keyword:
return+1 return+1
return(1) */ return(1) */
c = gfc_peek_char (); char c = gfc_peek_ascii_char ();
if (ISALPHA (c) || ISDIGIT (c)) if (ISALPHA (c) || ISDIGIT (c))
return MATCH_NO; return MATCH_NO;
} }
...@@ -2868,12 +2897,12 @@ gfc_match_common (void) ...@@ -2868,12 +2897,12 @@ gfc_match_common (void)
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
goto done; goto done;
if (gfc_peek_char () == '/') if (gfc_peek_ascii_char () == '/')
break; break;
if (gfc_match_char (',') != MATCH_YES) if (gfc_match_char (',') != MATCH_YES)
goto syntax; goto syntax;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (gfc_peek_char () == '/') if (gfc_peek_ascii_char () == '/')
break; break;
} }
} }
......
...@@ -38,7 +38,7 @@ extern gfc_st_label *gfc_statement_label; ...@@ -38,7 +38,7 @@ extern gfc_st_label *gfc_statement_label;
/* match.c. */ /* match.c. */
/* Generic match subroutines. */ /* 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_space (void);
match gfc_match_eos (void); match gfc_match_eos (void);
match gfc_match_small_literal_int (int *, int *); match gfc_match_small_literal_int (int *, int *);
......
...@@ -36,17 +36,17 @@ match ...@@ -36,17 +36,17 @@ match
gfc_match_omp_eos (void) gfc_match_omp_eos (void)
{ {
locus old_loc; locus old_loc;
int c; char c;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
switch (c) switch (c)
{ {
case '!': case '!':
do do
c = gfc_next_char (); c = gfc_next_ascii_char ();
while (c != '\n'); while (c != '\n');
/* Fall through */ /* Fall through */
......
...@@ -100,7 +100,7 @@ decode_specification_statement (void) ...@@ -100,7 +100,7 @@ decode_specification_statement (void)
{ {
gfc_statement st; gfc_statement st;
locus old_locus; locus old_locus;
int c; char c;
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
return ST_NONE; return ST_NONE;
...@@ -121,7 +121,7 @@ decode_specification_statement (void) ...@@ -121,7 +121,7 @@ decode_specification_statement (void)
statement, we eliminate most possibilities by peeking at the statement, we eliminate most possibilities by peeking at the
first character. */ first character. */
c = gfc_peek_char (); c = gfc_peek_ascii_char ();
switch (c) switch (c)
{ {
...@@ -229,7 +229,7 @@ decode_statement (void) ...@@ -229,7 +229,7 @@ decode_statement (void)
gfc_statement st; gfc_statement st;
locus old_locus; locus old_locus;
match m; match m;
int c; char c;
#ifdef GFC_DEBUG #ifdef GFC_DEBUG
gfc_symbol_state (); gfc_symbol_state ();
...@@ -315,7 +315,7 @@ decode_statement (void) ...@@ -315,7 +315,7 @@ decode_statement (void)
statement, we eliminate most possibilities by peeking at the statement, we eliminate most possibilities by peeking at the
first character. */ first character. */
c = gfc_peek_char (); c = gfc_peek_ascii_char ();
switch (c) switch (c)
{ {
...@@ -462,7 +462,7 @@ static gfc_statement ...@@ -462,7 +462,7 @@ static gfc_statement
decode_omp_directive (void) decode_omp_directive (void)
{ {
locus old_locus; locus old_locus;
int c; char c;
#ifdef GFC_DEBUG #ifdef GFC_DEBUG
gfc_symbol_state (); gfc_symbol_state ();
...@@ -485,7 +485,7 @@ decode_omp_directive (void) ...@@ -485,7 +485,7 @@ decode_omp_directive (void)
statement, we eliminate most possibilities by peeking at the statement, we eliminate most possibilities by peeking at the
first character. */ first character. */
c = gfc_peek_char (); c = gfc_peek_ascii_char ();
switch (c) switch (c)
{ {
...@@ -569,31 +569,34 @@ static gfc_statement ...@@ -569,31 +569,34 @@ static gfc_statement
next_free (void) next_free (void)
{ {
match m; match m;
int c, d, cnt, at_bol; int i, cnt, at_bol;
char c;
at_bol = gfc_at_bol (); at_bol = gfc_at_bol ();
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_peek_char (); c = gfc_peek_ascii_char ();
if (ISDIGIT (c)) if (ISDIGIT (c))
{ {
char d;
/* Found a statement label? */ /* Found a statement label? */
m = gfc_match_st_label (&gfc_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)) 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) if (cnt > 5)
gfc_error_now ("Too many digits in statement label at %C"); 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"); gfc_error_now ("Zero is not a valid statement label at %C");
do do
c = gfc_next_char (); c = gfc_next_ascii_char ();
while (ISDIGIT(c)); while (ISDIGIT(c));
if (!gfc_is_whitespace (c)) if (!gfc_is_whitespace (c))
...@@ -607,11 +610,11 @@ next_free (void) ...@@ -607,11 +610,11 @@ next_free (void)
gfc_gobble_whitespace (); 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 " gfc_error_now ("Semicolon at %C needs to be preceded by "
"statement"); "statement");
gfc_next_char (); /* Eat up the semicolon. */ gfc_next_ascii_char (); /* Eat up the semicolon. */
return ST_NONE; return ST_NONE;
} }
...@@ -633,8 +636,8 @@ next_free (void) ...@@ -633,8 +636,8 @@ next_free (void)
{ {
int i; int i;
c = gfc_next_char (); c = gfc_next_ascii_char ();
for (i = 0; i < 5; i++, c = gfc_next_char ()) for (i = 0; i < 5; i++, c = gfc_next_ascii_char ())
gcc_assert (c == "!$omp"[i]); gcc_assert (c == "!$omp"[i]);
gcc_assert (c == ' '); gcc_assert (c == ' ');
...@@ -646,7 +649,7 @@ next_free (void) ...@@ -646,7 +649,7 @@ next_free (void)
if (at_bol && c == ';') if (at_bol && c == ';')
{ {
gfc_error_now ("Semicolon at %C needs to be preceded by statement"); 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; return ST_NONE;
} }
...@@ -661,7 +664,7 @@ next_fixed (void) ...@@ -661,7 +664,7 @@ next_fixed (void)
{ {
int label, digit_flag, i; int label, digit_flag, i;
locus loc; locus loc;
char c; gfc_char_t c;
if (!gfc_at_bol ()) if (!gfc_at_bol ())
return decode_statement (); return decode_statement ();
...@@ -694,7 +697,7 @@ next_fixed (void) ...@@ -694,7 +697,7 @@ next_fixed (void)
case '7': case '7':
case '8': case '8':
case '9': case '9':
label = label * 10 + c - '0'; label = label * 10 + ((unsigned char) c - '0');
label_locus = gfc_current_locus; label_locus = gfc_current_locus;
digit_flag = 1; digit_flag = 1;
break; break;
...@@ -705,7 +708,7 @@ next_fixed (void) ...@@ -705,7 +708,7 @@ next_fixed (void)
if (gfc_option.flag_openmp) if (gfc_option.flag_openmp)
{ {
for (i = 0; i < 5; i++, c = gfc_next_char_literal (0)) 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') if (c != ' ' && c != '0')
{ {
......
...@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h" #include "arith.h"
#include "match.h" #include "match.h"
#include "parse.h" #include "parse.h"
#include "toplev.h"
/* Matches a kind-parameter expression, which is either a named /* Matches a kind-parameter expression, which is either a named
symbolic constant or a nonnegative integer constant. If symbolic constant or a nonnegative integer constant. If
...@@ -95,8 +96,8 @@ get_kind (void) ...@@ -95,8 +96,8 @@ get_kind (void)
/* Given a character and a radix, see if the character is a valid /* Given a character and a radix, see if the character is a valid
digit in that radix. */ digit in that radix. */
static int int
check_digit (int c, int radix) gfc_check_digit (char c, int radix)
{ {
int r; int r;
...@@ -119,7 +120,7 @@ check_digit (int c, int radix) ...@@ -119,7 +120,7 @@ check_digit (int c, int radix)
break; break;
default: default:
gfc_internal_error ("check_digit(): bad radix"); gfc_internal_error ("gfc_check_digit(): bad radix");
} }
return r; return r;
...@@ -135,21 +136,22 @@ static int ...@@ -135,21 +136,22 @@ static int
match_digits (int signflag, int radix, char *buffer) match_digits (int signflag, int radix, char *buffer)
{ {
locus old_loc; locus old_loc;
int length, c; int length;
char c;
length = 0; length = 0;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (signflag && (c == '+' || c == '-')) if (signflag && (c == '+' || c == '-'))
{ {
if (buffer != NULL) if (buffer != NULL)
*buffer++ = c; *buffer++ = c;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
length++; length++;
} }
if (!check_digit (c, radix)) if (!gfc_check_digit (c, radix))
return -1; return -1;
length++; length++;
...@@ -159,9 +161,9 @@ match_digits (int signflag, int radix, char *buffer) ...@@ -159,9 +161,9 @@ match_digits (int signflag, int radix, char *buffer)
for (;;) for (;;)
{ {
old_loc = gfc_current_locus; 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; break;
if (buffer != NULL) if (buffer != NULL)
...@@ -275,10 +277,13 @@ match_hollerith_constant (gfc_expr **result) ...@@ -275,10 +277,13 @@ match_hollerith_constant (gfc_expr **result)
&gfc_current_locus); &gfc_current_locus);
e->representation.string = gfc_getmem (num + 1); 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++) for (i = 0; i < num; i++)
{ e->representation.string[i]
e->representation.string[i] = gfc_next_char_literal (1); = (unsigned char) gfc_next_char_literal (1);
}
e->representation.string[num] = '\0'; e->representation.string[num] = '\0';
e->representation.length = num; e->representation.length = num;
...@@ -306,16 +311,16 @@ cleanup: ...@@ -306,16 +311,16 @@ cleanup:
static match static match
match_boz_constant (gfc_expr **result) 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; locus old_loc, start_loc;
char *buffer; char *buffer, post, delim;
gfc_expr *e; gfc_expr *e;
start_loc = old_loc = gfc_current_locus; start_loc = old_loc = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
x_hex = 0; x_hex = 0;
switch (post = gfc_next_char ()) switch (post = gfc_next_ascii_char ())
{ {
case 'b': case 'b':
radix = 2; radix = 2;
...@@ -346,7 +351,7 @@ match_boz_constant (gfc_expr **result) ...@@ -346,7 +351,7 @@ match_boz_constant (gfc_expr **result)
/* No whitespace allowed here. */ /* No whitespace allowed here. */
if (post == 0) if (post == 0)
delim = gfc_next_char (); delim = gfc_next_ascii_char ();
if (delim != '\'' && delim != '\"') if (delim != '\'' && delim != '\"')
goto backup; goto backup;
...@@ -366,7 +371,7 @@ match_boz_constant (gfc_expr **result) ...@@ -366,7 +371,7 @@ match_boz_constant (gfc_expr **result)
return MATCH_ERROR; return MATCH_ERROR;
} }
if (gfc_next_char () != delim) if (gfc_next_ascii_char () != delim)
{ {
gfc_error ("Illegal character in BOZ constant at %C"); gfc_error ("Illegal character in BOZ constant at %C");
return MATCH_ERROR; return MATCH_ERROR;
...@@ -374,7 +379,7 @@ match_boz_constant (gfc_expr **result) ...@@ -374,7 +379,7 @@ match_boz_constant (gfc_expr **result)
if (post == 1) if (post == 1)
{ {
switch (gfc_next_char ()) switch (gfc_next_ascii_char ())
{ {
case 'b': case 'b':
radix = 2; radix = 2;
...@@ -403,9 +408,9 @@ match_boz_constant (gfc_expr **result) ...@@ -403,9 +408,9 @@ match_boz_constant (gfc_expr **result)
memset (buffer, '\0', length + 1); memset (buffer, '\0', length + 1);
match_digits (0, radix, buffer); match_digits (0, radix, buffer);
gfc_next_char (); /* Eat delimiter. */ gfc_next_ascii_char (); /* Eat delimiter. */
if (post == 1) 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 /* 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 "If a data-stmt-constant is a boz-literal-constant, the corresponding
...@@ -448,9 +453,9 @@ backup: ...@@ -448,9 +453,9 @@ backup:
static match static match
match_real_constant (gfc_expr **result, int signflag) 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; locus old_loc, temp_loc;
char *p, *buffer; char *p, *buffer, c, exp_char;
gfc_expr *e; gfc_expr *e;
bool negate; bool negate;
...@@ -465,18 +470,18 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -465,18 +470,18 @@ match_real_constant (gfc_expr **result, int signflag)
exp_char = ' '; exp_char = ' ';
negate = FALSE; negate = FALSE;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (signflag && (c == '+' || c == '-')) if (signflag && (c == '+' || c == '-'))
{ {
if (c == '-') if (c == '-')
negate = TRUE; negate = TRUE;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
} }
/* Scan significand. */ /* Scan significand. */
for (;; c = gfc_next_char (), count++) for (;; c = gfc_next_ascii_char (), count++)
{ {
if (c == '.') if (c == '.')
{ {
...@@ -486,11 +491,11 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -486,11 +491,11 @@ match_real_constant (gfc_expr **result, int signflag)
/* Check to see if "." goes with a following operator like /* Check to see if "." goes with a following operator like
".eq.". */ ".eq.". */
temp_loc = gfc_current_locus; temp_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (c == 'e' || c == 'd' || c == 'q') if (c == 'e' || c == 'd' || c == 'q')
{ {
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (c == '.') if (c == '.')
goto done; /* Operator named .e. or .d. */ goto done; /* Operator named .e. or .d. */
} }
...@@ -517,12 +522,12 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -517,12 +522,12 @@ match_real_constant (gfc_expr **result, int signflag)
exp_char = c; exp_char = c;
/* Scan exponent. */ /* Scan exponent. */
c = gfc_next_char (); c = gfc_next_ascii_char ();
count++; count++;
if (c == '+' || c == '-') if (c == '+' || c == '-')
{ /* optional sign */ { /* optional sign */
c = gfc_next_char (); c = gfc_next_ascii_char ();
count++; count++;
} }
...@@ -534,7 +539,7 @@ match_real_constant (gfc_expr **result, int signflag) ...@@ -534,7 +539,7 @@ match_real_constant (gfc_expr **result, int signflag)
while (ISDIGIT (c)) while (ISDIGIT (c))
{ {
c = gfc_next_char (); c = gfc_next_ascii_char ();
count++; count++;
} }
...@@ -554,11 +559,11 @@ done: ...@@ -554,11 +559,11 @@ done:
memset (buffer, '\0', count + 1); memset (buffer, '\0', count + 1);
p = buffer; p = buffer;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (c == '+' || c == '-') if (c == '+' || c == '-')
{ {
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
} }
/* Hack for mpfr_set_str(). */ /* Hack for mpfr_set_str(). */
...@@ -572,7 +577,7 @@ done: ...@@ -572,7 +577,7 @@ done:
if (--count == 0) if (--count == 0)
break; break;
c = gfc_next_char (); c = gfc_next_ascii_char ();
} }
kind = get_kind (); kind = get_kind ();
...@@ -724,22 +729,26 @@ cleanup: ...@@ -724,22 +729,26 @@ cleanup:
return doubled delimiters on the input as a single instance of return doubled delimiters on the input as a single instance of
the delimiter. the delimiter.
Special return values are: Special return values for "ret" argument are:
-1 End of the string, as determined by the delimiter -1 End of the string, as determined by the delimiter
-2 Unterminated string detected -2 Unterminated string detected
Backslash codes are also expanded at this time. */ Backslash codes are also expanded at this time. */
static int static gfc_char_t
next_string_char (char delimiter) next_string_char (gfc_char_t delimiter, int *ret)
{ {
locus old_locus; locus old_locus;
int c; gfc_char_t c;
c = gfc_next_char_literal (1); c = gfc_next_char_literal (1);
*ret = 0;
if (c == '\n') if (c == '\n')
return -2; {
*ret = -2;
return 0;
}
if (gfc_option.flag_backslash && c == '\\') if (gfc_option.flag_backslash && c == '\\')
{ {
...@@ -762,7 +771,8 @@ next_string_char (char delimiter) ...@@ -762,7 +771,8 @@ next_string_char (char delimiter)
return c; return c;
gfc_current_locus = old_locus; gfc_current_locus = old_locus;
return -1; *ret = -1;
return 0;
} }
...@@ -786,7 +796,7 @@ match_charkind_name (char *name) ...@@ -786,7 +796,7 @@ match_charkind_name (char *name)
int len; int len;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (!ISALPHA (c)) if (!ISALPHA (c))
return MATCH_NO; return MATCH_NO;
...@@ -796,11 +806,11 @@ match_charkind_name (char *name) ...@@ -796,11 +806,11 @@ match_charkind_name (char *name)
for (;;) for (;;)
{ {
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_ascii_char ();
if (c == '_') if (c == '_')
{ {
peek = gfc_peek_char (); peek = gfc_peek_ascii_char ();
if (peek == '\'' || peek == '\"') if (peek == '\'' || peek == '\"')
{ {
...@@ -834,13 +844,14 @@ match_charkind_name (char *name) ...@@ -834,13 +844,14 @@ match_charkind_name (char *name)
static match static match
match_string_constant (gfc_expr **result) match_string_constant (gfc_expr **result)
{ {
char *p, name[GFC_MAX_SYMBOL_LEN + 1]; char *p, name[GFC_MAX_SYMBOL_LEN + 1], peek;
int i, c, kind, length, delimiter, warn_ampersand; int i, kind, length, warn_ampersand, ret;
locus old_locus, start_locus; locus old_locus, start_locus;
gfc_symbol *sym; gfc_symbol *sym;
gfc_expr *e; gfc_expr *e;
const char *q; const char *q;
match m; match m;
gfc_char_t c, delimiter;
old_locus = gfc_current_locus; old_locus = gfc_current_locus;
...@@ -855,11 +866,11 @@ match_string_constant (gfc_expr **result) ...@@ -855,11 +866,11 @@ match_string_constant (gfc_expr **result)
goto got_delim; goto got_delim;
} }
if (ISDIGIT (c)) if (gfc_wide_is_digit (c))
{ {
kind = 0; kind = 0;
while (ISDIGIT (c)) while (gfc_wide_is_digit (c))
{ {
kind = kind * 10 + c - '0'; kind = kind * 10 + c - '0';
if (kind > 9999999) if (kind > 9999999)
...@@ -929,10 +940,10 @@ got_delim: ...@@ -929,10 +940,10 @@ got_delim:
for (;;) for (;;)
{ {
c = next_string_char (delimiter); c = next_string_char (delimiter, &ret);
if (c == -1) if (ret == -1)
break; break;
if (c == -2) if (ret == -2)
{ {
gfc_current_locus = start_locus; gfc_current_locus = start_locus;
gfc_error ("Unterminated character constant beginning at %C"); gfc_error ("Unterminated character constant beginning at %C");
...@@ -944,8 +955,8 @@ got_delim: ...@@ -944,8 +955,8 @@ got_delim:
/* Peek at the next character to see if it is a b, o, z, or x for the /* Peek at the next character to see if it is a b, o, z, or x for the
postfixed BOZ literal constants. */ postfixed BOZ literal constants. */
c = gfc_peek_char (); peek = gfc_peek_ascii_char ();
if (c == 'b' || c == 'o' || c =='z' || c == 'x') if (peek == 'b' || peek == 'o' || peek =='z' || peek == 'x')
goto no_match; goto no_match;
...@@ -971,12 +982,24 @@ got_delim: ...@@ -971,12 +982,24 @@ got_delim:
gfc_option.warn_ampersand = 0; gfc_option.warn_ampersand = 0;
for (i = 0; i < length; i++) 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. */ *p = '\0'; /* TODO: C-style string is for development/debug purposes. */
gfc_option.warn_ampersand = warn_ampersand; 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"); gfc_internal_error ("match_string_constant(): Delimiter not found");
if (match_substring (NULL, 0, &e->ref) != MATCH_NO) if (match_substring (NULL, 0, &e->ref) != MATCH_NO)
...@@ -1000,25 +1023,25 @@ match_logical_constant_string (void) ...@@ -1000,25 +1023,25 @@ match_logical_constant_string (void)
locus orig_loc = gfc_current_locus; locus orig_loc = gfc_current_locus;
gfc_gobble_whitespace (); 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 (ch == 'f')
{ {
if (gfc_next_char () == 'a' if (gfc_next_ascii_char () == 'a'
&& gfc_next_char () == 'l' && gfc_next_ascii_char () == 'l'
&& gfc_next_char () == 's' && gfc_next_ascii_char () == 's'
&& gfc_next_char () == 'e' && gfc_next_ascii_char () == 'e'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
/* Matched ".false.". */ /* Matched ".false.". */
return 0; return 0;
} }
else if (ch == 't') else if (ch == 't')
{ {
if (gfc_next_char () == 'r' if (gfc_next_ascii_char () == 'r'
&& gfc_next_char () == 'u' && gfc_next_ascii_char () == 'u'
&& gfc_next_char () == 'e' && gfc_next_ascii_char () == 'e'
&& gfc_next_char () == '.') && gfc_next_ascii_char () == '.')
/* Matched ".true.". */ /* Matched ".true.". */
return 1; return 1;
} }
...@@ -1214,7 +1237,7 @@ match_complex_constant (gfc_expr **result) ...@@ -1214,7 +1237,7 @@ match_complex_constant (gfc_expr **result)
{ {
/* Give the matcher for implied do-loops a chance to run. This /* Give the matcher for implied do-loops a chance to run. This
yields a much saner error message for (/ (i, 4=i, 6) /). */ yields a much saner error message for (/ (i, 4=i, 6) /). */
if (gfc_peek_char () == '=') if (gfc_peek_ascii_char () == '=')
{ {
m = MATCH_ERROR; m = MATCH_ERROR;
goto cleanup; goto cleanup;
...@@ -1328,7 +1351,7 @@ match_actual_arg (gfc_expr **result) ...@@ -1328,7 +1351,7 @@ match_actual_arg (gfc_expr **result)
gfc_symtree *symtree; gfc_symtree *symtree;
locus where, w; locus where, w;
gfc_expr *e; gfc_expr *e;
int c; char c;
where = gfc_current_locus; where = gfc_current_locus;
...@@ -1343,7 +1366,7 @@ match_actual_arg (gfc_expr **result) ...@@ -1343,7 +1366,7 @@ match_actual_arg (gfc_expr **result)
case MATCH_YES: case MATCH_YES:
w = gfc_current_locus; w = gfc_current_locus;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
c = gfc_next_char (); c = gfc_next_ascii_char ();
gfc_current_locus = w; gfc_current_locus = w;
if (c != ',' && c != ')') if (c != ',' && c != ')')
...@@ -1684,7 +1707,7 @@ match_varspec (gfc_expr *primary, int equiv_flag) ...@@ -1684,7 +1707,7 @@ match_varspec (gfc_expr *primary, int equiv_flag)
tail = NULL; tail = NULL;
gfc_gobble_whitespace (); 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 /* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character an array, character variable or array of character
...@@ -1698,7 +1721,7 @@ match_varspec (gfc_expr *primary, int equiv_flag) ...@@ -1698,7 +1721,7 @@ match_varspec (gfc_expr *primary, int equiv_flag)
return m; return m;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (equiv_flag && gfc_peek_char () == '(') if (equiv_flag && gfc_peek_ascii_char () == '(')
{ {
tail = extend_ref (primary, tail); tail = extend_ref (primary, tail);
tail->type = REF_ARRAY; tail->type = REF_ARRAY;
...@@ -2101,7 +2124,7 @@ gfc_match_rvalue (gfc_expr **result) ...@@ -2101,7 +2124,7 @@ gfc_match_rvalue (gfc_expr **result)
/* See if this is a directly recursive function call. */ /* See if this is a directly recursive function call. */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (sym->attr.recursive if (sym->attr.recursive
&& gfc_peek_char () == '(' && gfc_peek_ascii_char () == '('
&& gfc_current_ns->proc_name == sym && gfc_current_ns->proc_name == sym
&& !sym->attr.dimension) && !sym->attr.dimension)
{ {
...@@ -2139,7 +2162,7 @@ gfc_match_rvalue (gfc_expr **result) ...@@ -2139,7 +2162,7 @@ gfc_match_rvalue (gfc_expr **result)
{ {
case FL_VARIABLE: case FL_VARIABLE:
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_get_default_type (sym, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns); gfc_set_default_type (sym, 0, sym->ns);
...@@ -2304,7 +2327,7 @@ gfc_match_rvalue (gfc_expr **result) ...@@ -2304,7 +2327,7 @@ gfc_match_rvalue (gfc_expr **result)
via an IMPLICIT statement. This can't wait for the via an IMPLICIT statement. This can't wait for the
resolution phase. */ resolution phase. */
if (gfc_peek_char () == '%' if (gfc_peek_ascii_char () == '%'
&& sym->ts.type == BT_UNKNOWN && sym->ts.type == BT_UNKNOWN
&& gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns); gfc_set_default_type (sym, 0, sym->ns);
...@@ -2333,7 +2356,7 @@ gfc_match_rvalue (gfc_expr **result) ...@@ -2333,7 +2356,7 @@ gfc_match_rvalue (gfc_expr **result)
variable is just a scalar. */ variable is just a scalar. */
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if (gfc_peek_char () != '(') if (gfc_peek_ascii_char () != '(')
{ {
/* Assume a scalar variable */ /* Assume a scalar variable */
e = gfc_get_expr (); e = gfc_get_expr ();
...@@ -2545,7 +2568,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) ...@@ -2545,7 +2568,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
break; break;
/* These are definitive indicators that this is a variable. */ /* 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) || sym->attr.pointer || sym->as != NULL)
flavor = FL_VARIABLE; flavor = FL_VARIABLE;
...@@ -2605,7 +2628,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) ...@@ -2605,7 +2628,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
else else
implicit_ns = sym->ns; implicit_ns = sym->ns;
if (gfc_peek_char () == '%' if (gfc_peek_ascii_char () == '%'
&& sym->ts.type == BT_UNKNOWN && sym->ts.type == BT_UNKNOWN
&& gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, implicit_ns); gfc_set_default_type (sym, 0, implicit_ns);
......
...@@ -72,7 +72,7 @@ static gfc_linebuf *line_head, *line_tail; ...@@ -72,7 +72,7 @@ static gfc_linebuf *line_head, *line_tail;
locus gfc_current_locus; locus gfc_current_locus;
const char *gfc_source_file; const char *gfc_source_file;
static FILE *gfc_src_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; extern int pedantic;
...@@ -85,6 +85,135 @@ static struct gfc_file_change ...@@ -85,6 +85,135 @@ static struct gfc_file_change
size_t file_changes_cur, file_changes_count; size_t file_changes_cur, file_changes_count;
size_t file_changes_allocated; 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. */ /* Main scanner initialization. */
void void
...@@ -406,15 +535,15 @@ gfc_advance_line (void) ...@@ -406,15 +535,15 @@ gfc_advance_line (void)
pointer from being on the wrong line if the current statement ends pointer from being on the wrong line if the current statement ends
prematurely. */ prematurely. */
static int static gfc_char_t
next_char (void) next_char (void)
{ {
int c; gfc_char_t c;
if (gfc_current_locus.nextc == NULL) if (gfc_current_locus.nextc == NULL)
return '\n'; return '\n';
c = (unsigned char) *gfc_current_locus.nextc++; c = *gfc_current_locus.nextc++;
if (c == '\0') if (c == '\0')
{ {
gfc_current_locus.nextc--; /* Remain on this line. */ gfc_current_locus.nextc--; /* Remain on this line. */
...@@ -433,7 +562,7 @@ next_char (void) ...@@ -433,7 +562,7 @@ next_char (void)
static void static void
skip_comment_line (void) skip_comment_line (void)
{ {
char c; gfc_char_t c;
do do
{ {
...@@ -448,17 +577,27 @@ skip_comment_line (void) ...@@ -448,17 +577,27 @@ skip_comment_line (void)
int int
gfc_define_undef_line (void) gfc_define_undef_line (void)
{ {
char *tmp;
/* All lines beginning with '#' are either #define or #undef. */ /* 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; return 0;
if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0) if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
(*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb), {
&(gfc_current_locus.nextc[8])); 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) if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
(*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb), {
&(gfc_current_locus.nextc[7])); 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 the rest of the line. */
skip_comment_line (); skip_comment_line ();
...@@ -476,7 +615,7 @@ static bool ...@@ -476,7 +615,7 @@ static bool
skip_free_comments (void) skip_free_comments (void)
{ {
locus start; locus start;
char c; gfc_char_t c;
int at_bol; int at_bol;
for (;;) for (;;)
...@@ -570,7 +709,7 @@ skip_fixed_comments (void) ...@@ -570,7 +709,7 @@ skip_fixed_comments (void)
{ {
locus start; locus start;
int col; int col;
char c; gfc_char_t c;
if (! gfc_at_bol ()) if (! gfc_at_bol ())
{ {
...@@ -738,11 +877,12 @@ gfc_skip_comments (void) ...@@ -738,11 +877,12 @@ gfc_skip_comments (void)
line. The in_string flag denotes whether we're inside a character line. The in_string flag denotes whether we're inside a character
context or not. */ context or not. */
int gfc_char_t
gfc_next_char_literal (int in_string) gfc_next_char_literal (int in_string)
{ {
locus old_loc; locus old_loc;
int i, c, prev_openmp_flag; int i, prev_openmp_flag;
gfc_char_t c;
continue_flag = 0; continue_flag = 0;
...@@ -859,7 +999,7 @@ restart: ...@@ -859,7 +999,7 @@ restart:
{ {
for (i = 0; i < 5; i++, c = next_char ()) 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) if (i == 4)
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
} }
...@@ -932,7 +1072,7 @@ restart: ...@@ -932,7 +1072,7 @@ restart:
for (i = 0; i < 5; i++) for (i = 0; i < 5; i++)
{ {
c = next_char (); c = next_char ();
if (TOLOWER (c) != "*$omp"[i]) if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation; goto not_continuation;
} }
...@@ -980,10 +1120,10 @@ done: ...@@ -980,10 +1120,10 @@ done:
parsing character literals, they have to call parsing character literals, they have to call
gfc_next_char_literal(). */ gfc_next_char_literal(). */
int gfc_char_t
gfc_next_char (void) gfc_next_char (void)
{ {
int c; gfc_char_t c;
do do
{ {
...@@ -991,15 +1131,24 @@ gfc_next_char (void) ...@@ -991,15 +1131,24 @@ gfc_next_char (void)
} }
while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c)); 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) gfc_peek_char (void)
{ {
locus old_loc; locus old_loc;
int c; gfc_char_t c;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
c = gfc_next_char (); c = gfc_next_char ();
...@@ -1009,6 +1158,16 @@ gfc_peek_char (void) ...@@ -1009,6 +1158,16 @@ gfc_peek_char (void)
} }
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 /* 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' 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 or a ';'. We also assume that we are not within a character
...@@ -1017,7 +1176,7 @@ gfc_peek_char (void) ...@@ -1017,7 +1176,7 @@ gfc_peek_char (void)
void void
gfc_error_recovery (void) gfc_error_recovery (void)
{ {
char c, delim; gfc_char_t c, delim;
if (gfc_at_eof ()) if (gfc_at_eof ())
return; return;
...@@ -1064,7 +1223,7 @@ gfc_gobble_whitespace (void) ...@@ -1064,7 +1223,7 @@ gfc_gobble_whitespace (void)
{ {
static int linenum = 0; static int linenum = 0;
locus old_loc; locus old_loc;
int c; gfc_char_t c;
do do
{ {
...@@ -1106,13 +1265,13 @@ gfc_gobble_whitespace (void) ...@@ -1106,13 +1265,13 @@ gfc_gobble_whitespace (void)
parts of gfortran. */ parts of gfortran. */
static int 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; static int linenum = 0, current_line = 1;
int c, maxlen, i, preprocessor_flag, buflen = *pbuflen; int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0, seen_comment = 0; int trunc_flag = 0, seen_comment = 0;
int seen_printable = 0, seen_ampersand = 0; int seen_printable = 0, seen_ampersand = 0;
char *buffer; gfc_char_t *buffer;
bool found_tab = false; bool found_tab = false;
/* Determine the maximum allowed line length. */ /* Determine the maximum allowed line length. */
...@@ -1135,7 +1294,7 @@ load_line (FILE *input, char **pbuf, int *pbuflen) ...@@ -1135,7 +1294,7 @@ load_line (FILE *input, char **pbuf, int *pbuflen)
else else
buflen = 132; buflen = 132;
*pbuf = gfc_getmem (buflen + 1); *pbuf = gfc_getmem ((buflen + 1) * sizeof (gfc_char_t));
} }
i = 0; i = 0;
...@@ -1234,7 +1393,7 @@ load_line (FILE *input, char **pbuf, int *pbuflen) ...@@ -1234,7 +1393,7 @@ load_line (FILE *input, char **pbuf, int *pbuflen)
/* Reallocate line buffer to double size to hold the /* Reallocate line buffer to double size to hold the
overlong line. */ overlong line. */
buflen = buflen * 2; buflen = buflen * 2;
*pbuf = xrealloc (*pbuf, buflen + 1); *pbuf = xrealloc (*pbuf, (buflen + 1) * sizeof (gfc_char_t));
buffer = (*pbuf) + i; buffer = (*pbuf) + i;
} }
} }
...@@ -1297,17 +1456,19 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED) ...@@ -1297,17 +1456,19 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
return f; return f;
} }
/* Deal with a line from the C preprocessor. The /* Deal with a line from the C preprocessor. The
initial octothorp has already been seen. */ initial octothorp has already been seen. */
static void static void
preprocessor_line (char *c) preprocessor_line (gfc_char_t *c)
{ {
bool flag[5]; bool flag[5];
int i, line; int i, line;
char *filename; gfc_char_t *wide_filename;
gfc_file *f; gfc_file *f;
int escaped, unescape; int escaped, unescape;
char *filename;
c++; c++;
while (*c == ' ' || *c == '\t') while (*c == ' ' || *c == '\t')
...@@ -1316,9 +1477,9 @@ preprocessor_line (char *c) ...@@ -1316,9 +1477,9 @@ preprocessor_line (char *c)
if (*c < '0' || *c > '9') if (*c < '0' || *c > '9')
goto bad_cpp_line; goto bad_cpp_line;
line = atoi (c); line = wide_atoi (c);
c = strchr (c, ' '); c = wide_strchr (c, ' ');
if (c == NULL) if (c == NULL)
{ {
/* No file name given. Set new line number. */ /* No file name given. Set new line number. */
...@@ -1335,7 +1496,7 @@ preprocessor_line (char *c) ...@@ -1335,7 +1496,7 @@ preprocessor_line (char *c)
goto bad_cpp_line; goto bad_cpp_line;
++c; ++c;
filename = c; wide_filename = c;
/* Make filename end at quote. */ /* Make filename end at quote. */
unescape = 0; unescape = 0;
...@@ -1361,10 +1522,10 @@ preprocessor_line (char *c) ...@@ -1361,10 +1522,10 @@ preprocessor_line (char *c)
/* Undo effects of cpp_quote_string. */ /* Undo effects of cpp_quote_string. */
if (unescape) if (unescape)
{ {
char *s = filename; gfc_char_t *s = wide_filename;
char *d = gfc_getmem (c - filename - unescape); gfc_char_t *d = gfc_getmem (c - wide_filename - unescape);
filename = d; wide_filename = d;
while (*s) while (*s)
{ {
if (*s == '\\') if (*s == '\\')
...@@ -1382,17 +1543,21 @@ preprocessor_line (char *c) ...@@ -1382,17 +1543,21 @@ preprocessor_line (char *c)
for (;;) for (;;)
{ {
c = strchr (c, ' '); c = wide_strchr (c, ' ');
if (c == NULL) if (c == NULL)
break; break;
c++; c++;
i = atoi (c); i = wide_atoi (c);
if (1 <= i && i <= 4) if (1 <= i && i <= 4)
flag[i] = true; flag[i] = true;
} }
/* Convert the filename in wide characters into a filename in narrow
characters. */
filename = widechar_to_char (wide_filename);
/* Interpret flags. */ /* Interpret flags. */
if (flag[1]) /* Starting new file. */ if (flag[1]) /* Starting new file. */
...@@ -1411,7 +1576,8 @@ preprocessor_line (char *c) ...@@ -1411,7 +1576,8 @@ preprocessor_line (char *c)
current_file->filename, current_file->line, current_file->filename, current_file->line,
filename); filename);
if (unescape) if (unescape)
gfc_free (filename); gfc_free (wide_filename);
gfc_free (filename);
return; return;
} }
...@@ -1434,7 +1600,8 @@ preprocessor_line (char *c) ...@@ -1434,7 +1600,8 @@ preprocessor_line (char *c)
/* Set new line number. */ /* Set new line number. */
current_file->line = line; current_file->line = line;
if (unescape) if (unescape)
gfc_free (filename); gfc_free (wide_filename);
gfc_free (filename);
return; return;
bad_cpp_line: bad_cpp_line:
...@@ -1453,9 +1620,10 @@ static try load_file (const char *, bool); ...@@ -1453,9 +1620,10 @@ static try load_file (const char *, bool);
processed or true if we matched an include. */ processed or true if we matched an include. */
static bool 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; c = line;
...@@ -1479,8 +1647,8 @@ include_line (char *line) ...@@ -1479,8 +1647,8 @@ include_line (char *line)
while (*c == ' ' || *c == '\t') while (*c == ' ' || *c == '\t')
c++; c++;
if (strncasecmp (c, "include", 7)) if (wide_strncasecmp (c, "include", 7))
return false; return false;
c += 7; c += 7;
while (*c == ' ' || *c == '\t') while (*c == ' ' || *c == '\t')
...@@ -1513,7 +1681,9 @@ include_line (char *line) ...@@ -1513,7 +1681,9 @@ include_line (char *line)
*stop = '\0'; /* It's ok to trash the buffer, as this line won't be *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
read by anything else. */ read by anything else. */
load_file (begin, false); filename = widechar_to_char (begin);
load_file (filename, false);
gfc_free (filename);
return true; return true;
} }
...@@ -1523,7 +1693,7 @@ include_line (char *line) ...@@ -1523,7 +1693,7 @@ include_line (char *line)
static try static try
load_file (const char *filename, bool initial) load_file (const char *filename, bool initial)
{ {
char *line; gfc_char_t *line;
gfc_linebuf *b; gfc_linebuf *b;
gfc_file *f; gfc_file *f;
FILE *input; FILE *input;
...@@ -1590,7 +1760,7 @@ load_file (const char *filename, bool initial) ...@@ -1590,7 +1760,7 @@ load_file (const char *filename, bool initial)
{ {
int trunc = load_line (input, &line, &line_len); int trunc = load_line (input, &line, &line_len);
len = strlen (line); len = gfc_wide_strlen (line);
if (feof (input) && len == 0) if (feof (input) && len == 0)
break; break;
...@@ -1600,15 +1770,18 @@ load_file (const char *filename, bool initial) ...@@ -1600,15 +1770,18 @@ load_file (const char *filename, bool initial)
FE FF is UTF-16 big endian, FE FF is UTF-16 big endian,
EF BB BF is UTF-8. */ EF BB BF is UTF-8. */
if (first_line if (first_line
&& ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE') && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
|| (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF') && line[1] == (unsigned char) '\xFE')
|| (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB' || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
&& line[2] == '\xBF'))) && 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; int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
char * new = gfc_getmem (line_len); gfc_char_t *new = gfc_getmem (line_len * sizeof (gfc_char_t));
strcpy (new, line + n); wide_strcpy (new, &line[n]);
gfc_free (line); gfc_free (line);
line = new; line = new;
len -= n; len -= n;
...@@ -1623,8 +1796,8 @@ load_file (const char *filename, bool initial) ...@@ -1623,8 +1796,8 @@ load_file (const char *filename, bool initial)
and #undef lines, which we need to pass to the middle-end and #undef lines, which we need to pass to the middle-end
so that it can emit correct debug info. */ so that it can emit correct debug info. */
if (debug_info_level == DINFO_LEVEL_VERBOSE if (debug_info_level == DINFO_LEVEL_VERBOSE
&& (strncmp (line, "#define ", 8) == 0 && (wide_strncmp (line, "#define ", 8) == 0
|| strncmp (line, "#undef ", 7) == 0)) || wide_strncmp (line, "#undef ", 7) == 0))
; ;
else else
{ {
...@@ -1646,13 +1819,14 @@ load_file (const char *filename, bool initial) ...@@ -1646,13 +1819,14 @@ load_file (const char *filename, bool initial)
/* Add line. */ /* 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 b->location
= linemap_line_start (line_table, current_file->line++, 120); = linemap_line_start (line_table, current_file->line++, 120);
b->file = current_file; b->file = current_file;
b->truncated = trunc; b->truncated = trunc;
strcpy (b->line, line); wide_strcpy (b->line, line);
if (line_head == NULL) if (line_head == NULL)
line_head = b; line_head = b;
...@@ -1752,7 +1926,7 @@ const char * ...@@ -1752,7 +1926,7 @@ const char *
gfc_read_orig_filename (const char *filename, const char **canon_source_file) gfc_read_orig_filename (const char *filename, const char **canon_source_file)
{ {
int c, len; int c, len;
char *dirname; char *dirname, *tmp;
gfc_src_file = gfc_open_file (filename); gfc_src_file = gfc_open_file (filename);
if (gfc_src_file == NULL) if (gfc_src_file == NULL)
...@@ -1767,10 +1941,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) ...@@ -1767,10 +1941,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
len = 0; len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len); 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; 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) if (filename == NULL)
return NULL; return NULL;
...@@ -1783,10 +1959,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) ...@@ -1783,10 +1959,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
len = 0; len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len); 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; 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) if (dirname == NULL)
return filename; return filename;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment