X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Ffortran%2Fscanner.c;h=c226baee9667780f71250a317751d2c46bf949f3;hp=92ee3661480a699a4f2c0150b1f96a9eb01c0f80;hb=857616f6172b13aec886bb0b3e2e166f5e75622b;hpb=40da2b01e4cc57a1cf890af8966a9fe49b748473 diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 92ee3661480..c226baee966 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1,13 +1,13 @@ /* Character scanner. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 - Free Software Foundation, Inc. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, + 2010 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. GCC is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 2, or (at your option) any later +Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY @@ -16,9 +16,8 @@ FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GCC; see the file COPYING. If not, write to the Free -Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301, USA. */ +along with GCC; see the file COPYING3. If not see +. */ /* Set of subroutines to (ultimately) return the next character to the various matching subroutines. This file's job is to read files and @@ -45,24 +44,29 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "config.h" #include "system.h" #include "gfortran.h" -#include "toplev.h" +#include "toplev.h" /* For set_src_pwd. */ +#include "debug.h" +#include "flags.h" +#include "cpp.h" /* Structure for holding module and include file search path. */ typedef struct gfc_directorylist { char *path; + bool use_for_modules; struct gfc_directorylist *next; } gfc_directorylist; /* List of include file search directories. */ -static gfc_directorylist *include_dirs; +static gfc_directorylist *include_dirs, *intrinsic_modules_dirs; static gfc_file *file_head, *current_file; -static int continue_flag, end_flag, openmp_flag; +static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag; static int continue_count, continue_line; static locus openmp_locus; +static locus gcc_attribute_locus; gfc_source_form gfc_current_form; static gfc_linebuf *line_head, *line_tail; @@ -70,9 +74,192 @@ static gfc_linebuf *line_head, *line_tail; 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]; + +static struct gfc_file_change +{ + const char *filename; + gfc_linebuf *lb; + int line; +} *file_changes; +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); +} + +gfc_char_t +gfc_wide_toupper (gfc_char_t c) +{ + return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((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; +} + +gfc_char_t * +gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len) +{ + size_t i; + + for (i = 0; i < len; i++) + b[i] = c; + + return b; +} + +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 (const gfc_char_t *s, gfc_char_t c) +{ + do { + if (*s == c) + { + return CONST_CAST(gfc_char_t *, s); + } + } while (*s++); + return 0; +} + +char * +gfc_widechar_to_char (const gfc_char_t *s, int length) +{ + size_t len, i; + char *res; + + if (s == NULL) + return NULL; + + /* Passing a negative length is used to indicate that length should be + calculated using gfc_wide_strlen(). */ + len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s)); + res = XNEWVEC (char, len + 1); + + for (i = 0; i < len; i++) + { + gcc_assert (gfc_wide_fits_in_byte (s[i])); + res[i] = (unsigned char) s[i]; + } + + res[len] = '\0'; + return res; +} + +gfc_char_t * +gfc_char_to_widechar (const char *s) +{ + size_t len, i; + gfc_char_t *res; + + if (s == NULL) + return NULL; + + len = strlen (s); + res = gfc_get_wide_string (len + 1); + + for (i = 0; i < len; i++) + res[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; +} + +int +gfc_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; +} -extern int pedantic; /* Main scanner initialization. */ @@ -112,44 +299,67 @@ gfc_scanner_done_1 (void) gfc_free(file_head); file_head = f; } - } /* Adds path to the list pointed to by list. */ -void -gfc_add_include_path (const char *path) +static void +add_path_to_list (gfc_directorylist **list, const char *path, + bool use_for_modules, bool head) { gfc_directorylist *dir; const char *p; p = path; - while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */ + while (*p == ' ' || *p == '\t') /* someone might do "-I include" */ if (*p++ == '\0') return; - dir = include_dirs; - if (!dir) + if (head || *list == NULL) { - dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist)); + dir = XCNEW (gfc_directorylist); + if (!head) + *list = dir; } else { + dir = *list; while (dir->next) dir = dir->next; - dir->next = gfc_getmem (sizeof (gfc_directorylist)); + dir->next = XCNEW (gfc_directorylist); dir = dir->next; } - dir->next = NULL; - dir->path = gfc_getmem (strlen (p) + 2); + dir->next = head ? *list : NULL; + if (head) + *list = dir; + dir->use_for_modules = use_for_modules; + dir->path = XCNEWVEC (char, strlen (p) + 2); strcpy (dir->path, p); strcat (dir->path, "/"); /* make '/' last character */ } +void +gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir) +{ + add_path_to_list (&include_dirs, path, use_for_modules, file_dir); + + /* For '#include "..."' these directories are automatically searched. */ + if (!file_dir) + gfc_cpp_add_include_path (xstrdup(path), true); +} + + +void +gfc_add_intrinsic_modules_path (const char *path) +{ + add_path_to_list (&intrinsic_modules_dirs, path, true, false); +} + + /* Release resources allocated for options. */ void @@ -157,7 +367,6 @@ gfc_release_include_path (void) { gfc_directorylist *p; - gfc_free (gfc_option.module_dir); while (include_dirs != NULL) { p = include_dirs; @@ -165,46 +374,96 @@ gfc_release_include_path (void) gfc_free (p->path); gfc_free (p); } + + while (intrinsic_modules_dirs != NULL) + { + p = intrinsic_modules_dirs; + intrinsic_modules_dirs = intrinsic_modules_dirs->next; + gfc_free (p->path); + gfc_free (p); + } + + gfc_free (gfc_option.module_dir); } -/* Opens file for reading, searching through the include directories - given if necessary. If the include_cwd argument is true, we try - to open the file in the current directory first. */ -FILE * -gfc_open_included_file (const char *name, const bool include_cwd) +static FILE * +open_included_file (const char *name, gfc_directorylist *list, + bool module, bool system) { char *fullname; gfc_directorylist *p; FILE *f; - if (include_cwd) + for (p = list; p; p = p->next) { - f = gfc_open_file (name); - if (f != NULL) - return f; - } + if (module && !p->use_for_modules) + continue; - for (p = include_dirs; p; p = p->next) - { fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1); strcpy (fullname, p->path); strcat (fullname, name); f = gfc_open_file (fullname); if (f != NULL) - return f; + { + if (gfc_cpp_makedep ()) + gfc_cpp_add_dep (fullname, system); + + return f; + } } return NULL; } + +/* Opens file for reading, searching through the include directories + given if necessary. If the include_cwd argument is true, we try + to open the file in the current directory first. */ + +FILE * +gfc_open_included_file (const char *name, bool include_cwd, bool module) +{ + FILE *f = NULL; + + if (IS_ABSOLUTE_PATH (name) || include_cwd) + { + f = gfc_open_file (name); + if (f && gfc_cpp_makedep ()) + gfc_cpp_add_dep (name, false); + } + + if (!f) + f = open_included_file (name, include_dirs, module, false); + + return f; +} + +FILE * +gfc_open_intrinsic_module (const char *name) +{ + FILE *f = NULL; + + if (IS_ABSOLUTE_PATH (name)) + { + f = gfc_open_file (name); + if (f && gfc_cpp_makedep ()) + gfc_cpp_add_dep (name, true); + } + + if (!f) + f = open_included_file (name, intrinsic_modules_dirs, true, true); + + return f; +} + + /* Test to see if we're at the end of the main source file. */ int gfc_at_end (void) { - return end_flag; } @@ -214,7 +473,6 @@ gfc_at_end (void) int gfc_at_eof (void) { - if (gfc_at_end ()) return 1; @@ -245,13 +503,66 @@ gfc_at_bol (void) int gfc_at_eol (void) { - if (gfc_at_eof ()) return 1; return (*gfc_current_locus.nextc == '\0'); } +static void +add_file_change (const char *filename, int line) +{ + if (file_changes_count == file_changes_allocated) + { + if (file_changes_allocated) + file_changes_allocated *= 2; + else + file_changes_allocated = 16; + file_changes = XRESIZEVEC (struct gfc_file_change, file_changes, + file_changes_allocated); + } + file_changes[file_changes_count].filename = filename; + file_changes[file_changes_count].lb = NULL; + file_changes[file_changes_count++].line = line; +} + +static void +report_file_change (gfc_linebuf *lb) +{ + size_t c = file_changes_cur; + while (c < file_changes_count + && file_changes[c].lb == lb) + { + if (file_changes[c].filename) + (*debug_hooks->start_source_file) (file_changes[c].line, + file_changes[c].filename); + else + (*debug_hooks->end_source_file) (file_changes[c].line); + ++c; + } + file_changes_cur = c; +} + +void +gfc_start_source_files (void) +{ + /* If the debugger wants the name of the main source file, + we give it. */ + if (debug_hooks->start_end_main_source_file) + (*debug_hooks->start_source_file) (0, gfc_source_file); + + file_changes_cur = 0; + report_file_change (gfc_current_locus.lb); +} + +void +gfc_end_source_files (void) +{ + report_file_change (NULL); + + if (debug_hooks->start_end_main_source_file) + (*debug_hooks->end_source_file) (0); +} /* Advance the current line pointer to the next line. */ @@ -267,9 +578,16 @@ gfc_advance_line (void) return; } + if (gfc_current_locus.lb->next + && !gfc_current_locus.lb->next->dbg_emitted) + { + report_file_change (gfc_current_locus.lb->next); + gfc_current_locus.lb->next->dbg_emitted = true; + } + gfc_current_locus.lb = gfc_current_locus.lb->next; - if (gfc_current_locus.lb != NULL) + if (gfc_current_locus.lb != NULL) gfc_current_locus.nextc = gfc_current_locus.lb->line; else { @@ -288,10 +606,10 @@ gfc_advance_line (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'; @@ -306,15 +624,16 @@ next_char (void) return c; } + /* Skip a comment. When we come here the parse pointer is positioned immediately after the comment character. If we ever implement - compiler directives withing comments, here is where we parse the + compiler directives within comments, here is where we parse the directive. */ static void skip_comment_line (void) { - char c; + gfc_char_t c; do { @@ -326,6 +645,66 @@ skip_comment_line (void) } +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_ascii_char () != '#') + return 0; + + if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0) + { + tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1); + (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb), + tmp); + gfc_free (tmp); + } + + if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0) + { + tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1); + (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb), + tmp); + gfc_free (tmp); + } + + /* Skip the rest of the line. */ + skip_comment_line (); + + return 1; +} + + +/* Return true if GCC$ was matched. */ +static bool +skip_gcc_attribute (locus start) +{ + bool r = false; + char c; + locus old_loc = gfc_current_locus; + + if ((c = next_char ()) == 'g' || c == 'G') + if ((c = next_char ()) == 'c' || c == 'C') + if ((c = next_char ()) == 'c' || c == 'C') + if ((c = next_char ()) == '$') + r = true; + + if (r == false) + gfc_current_locus = old_loc; + else + { + gcc_attribute_flag = 1; + gcc_attribute_locus = old_loc; + gfc_current_locus = start; + } + + return r; +} + + + /* Comment lines are null lines, lines containing only blanks or lines on which the first nonblank line is a '!'. Return true if !$ openmp conditional compilation sentinel was @@ -335,7 +714,7 @@ static bool skip_free_comments (void) { locus start; - char c; + gfc_char_t c; int at_bol; for (;;) @@ -357,12 +736,16 @@ skip_free_comments (void) if (c == '!') { + /* Keep the !GCC$ line. */ + if (at_bol && skip_gcc_attribute (start)) + return false; + /* If -fopenmp, we need to handle here 2 things: 1) don't treat !$omp as comments, but directives 2) handle OpenMP conditional compilation, where !$ should be treated as 2 spaces (for initial lines only if followed by space). */ - if (gfc_option.flag_openmp && at_bol) + if (gfc_option.gfc_flag_openmp && at_bol) { locus old_loc = gfc_current_locus; if (next_char () == '$') @@ -371,24 +754,32 @@ skip_free_comments (void) if (c == 'o' || c == 'O') { if (((c = next_char ()) == 'm' || c == 'M') - && ((c = next_char ()) == 'p' || c == 'P') - && ((c = next_char ()) == ' ' || continue_flag)) + && ((c = next_char ()) == 'p' || c == 'P')) { - while (gfc_is_whitespace (c)) - c = next_char (); - if (c != '\n' && c != '!') + if ((c = next_char ()) == ' ' || c == '\t' + || continue_flag) { - openmp_flag = 1; - openmp_locus = old_loc; - gfc_current_locus = start; - return false; + while (gfc_is_whitespace (c)) + c = next_char (); + if (c != '\n' && c != '!') + { + openmp_flag = 1; + openmp_locus = old_loc; + gfc_current_locus = start; + return false; + } } + else + gfc_warning_now ("!$OMP at %C starts a commented " + "line as it neither is followed " + "by a space nor is a " + "continuation line"); } gfc_current_locus = old_loc; next_char (); c = next_char (); } - if (continue_flag || c == ' ') + if (continue_flag || c == ' ' || c == '\t') { gfc_current_locus = old_loc; next_char (); @@ -407,6 +798,8 @@ skip_free_comments (void) if (openmp_flag && at_bol) openmp_flag = 0; + + gcc_attribute_flag = 0; gfc_current_locus = start; return false; } @@ -422,7 +815,7 @@ skip_fixed_comments (void) { locus start; int col; - char c; + gfc_char_t c; if (! gfc_at_bol ()) { @@ -461,13 +854,24 @@ skip_fixed_comments (void) if (c == '!' || c == 'c' || c == 'C' || c == '*') { + if (skip_gcc_attribute (start)) + { + /* Canonicalize to *$omp. */ + *start.nextc = '*'; + return; + } + /* If -fopenmp, we need to handle here 2 things: 1) don't treat !$omp|c$omp|*$omp as comments, but directives 2) handle OpenMP conditional compilation, where !$|c$|*$ should be treated as 2 spaces if the characters in columns 3 to 6 are valid fixed form label columns characters. */ - if (gfc_option.flag_openmp) + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + + if (gfc_option.gfc_flag_openmp) { if (next_char () == '$') { @@ -480,11 +884,11 @@ skip_fixed_comments (void) c = next_char (); if (c != '\n' && ((openmp_flag && continue_flag) - || c == ' ' || c == '0')) + || c == ' ' || c == '\t' || c == '0')) { - c = next_char (); - while (gfc_is_whitespace (c)) + do c = next_char (); + while (gfc_is_whitespace (c)); if (c != '\n' && c != '!') { /* Canonicalize to *$omp. */ @@ -503,6 +907,11 @@ skip_fixed_comments (void) for (col = 3; col < 6; col++, c = next_char ()) if (c == ' ') continue; + else if (c == '\t') + { + col = 6; + break; + } else if (c < '0' || c > '9') break; else @@ -510,7 +919,7 @@ skip_fixed_comments (void) if (col == 6 && c != '\n' && ((continue_flag && !digit_seen) - || c == ' ' || c == '0')) + || c == ' ' || c == '\t' || c == '0')) { gfc_current_locus = start; start.nextc[0] = ' '; @@ -552,6 +961,9 @@ skip_fixed_comments (void) if (col != 6 && c == '!') { + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); skip_comment_line (); continue; } @@ -560,6 +972,7 @@ skip_fixed_comments (void) } openmp_flag = 0; + gcc_attribute_flag = 0; gfc_current_locus = start; } @@ -583,11 +996,12 @@ gfc_skip_comments (void) line. The in_string flag denotes whether we're inside a character context or not. */ -int -gfc_next_char_literal (int in_string) +gfc_char_t +gfc_next_char_literal (gfc_instring in_string) { locus old_loc; - int i, c, prev_openmp_flag; + int i, prev_openmp_flag; + gfc_char_t c; continue_flag = 0; @@ -605,6 +1019,11 @@ restart: if (!in_string && c == '!') { + if (gcc_attribute_flag + && memcmp (&gfc_current_locus, &gcc_attribute_locus, + sizeof (gfc_current_locus)) == 0) + goto done; + if (openmp_flag && memcmp (&gfc_current_locus, &openmp_locus, sizeof (gfc_current_locus)) == 0) @@ -623,6 +1042,17 @@ restart: goto done; } + /* Check to see if the continuation line was truncated. */ + if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL + && gfc_current_locus.lb->truncated) + { + int maxlen = gfc_option.free_line_length; + gfc_current_locus.lb->truncated = 0; + gfc_current_locus.nextc += maxlen; + gfc_warning_now ("Line truncated at %L", &gfc_current_locus); + gfc_current_locus.nextc -= maxlen; + } + if (c != '&') goto done; @@ -657,25 +1087,30 @@ restart: skip_comment_line (); else gfc_advance_line (); + + if (gfc_at_eof()) + goto not_continuation; /* We've got a continuation line. If we are on the very next line after the last continuation, increment the continuation line count and check whether the limit has been exceeded. */ - if (gfc_current_locus.lb->linenum == continue_line + 1) + if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1) { if (++continue_count == gfc_option.max_continue_free) { - if (gfc_notification_std (GFC_STD_GNU) - || pedantic) - gfc_warning ("Limit of %d continuations exceeded in statement at %C", - gfc_option.max_continue_free); + if (gfc_notification_std (GFC_STD_GNU) || pedantic) + gfc_warning ("Limit of %d continuations exceeded in " + "statement at %C", gfc_option.max_continue_free); } } - continue_line = gfc_current_locus.lb->linenum; /* Now find where it continues. First eat any comment lines. */ openmp_cond_flag = skip_free_comments (); + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (prev_openmp_flag != openmp_flag) { gfc_current_locus = old_loc; @@ -699,7 +1134,7 @@ restart: { 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; } @@ -711,9 +1146,10 @@ restart: { if (in_string) { - if (gfc_option.warn_ampersand) - gfc_warning_now ("Missing '&' in continued character constant at %C"); gfc_current_locus.nextc--; + if (gfc_option.warn_ampersand && in_string == INSTRING_WARN) + gfc_warning ("Missing '&' in continued character " + "constant at %C"); } /* Both !$omp and !$ -fopenmp continuation lines have & on the continuation line only optionally. */ @@ -727,7 +1163,7 @@ restart: } } } - else + else /* Fixed form. */ { /* Fixed form continuation. */ if (!in_string && c == '!') @@ -746,6 +1182,14 @@ restart: if (c != '\n') goto done; + /* Check to see if the continuation line was truncated. */ + if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL + && gfc_current_locus.lb->truncated) + { + gfc_current_locus.lb->truncated = 0; + gfc_warning_now ("Line truncated at %L", &gfc_current_locus); + } + prev_openmp_flag = openmp_flag; continue_flag = 1; old_loc = gfc_current_locus; @@ -771,7 +1215,7 @@ restart: 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; } @@ -782,19 +1226,20 @@ restart: /* We've got a continuation line. If we are on the very next line after the last continuation, increment the continuation line count and check whether the limit has been exceeded. */ - if (gfc_current_locus.lb->linenum == continue_line + 1) + if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1) { if (++continue_count == gfc_option.max_continue_fixed) { - if (gfc_notification_std (GFC_STD_GNU) - || pedantic) - gfc_warning ("Limit of %d continuations exceeded in statement at %C", - gfc_option.max_continue_fixed); + if (gfc_notification_std (GFC_STD_GNU) || pedantic) + gfc_warning ("Limit of %d continuations exceeded in " + "statement at %C", + gfc_option.max_continue_fixed); } } - if (continue_line < gfc_current_locus.lb->linenum) - continue_line = gfc_current_locus.lb->linenum; + if (gfc_current_locus.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); } /* Ready to read first character of continuation line, which might @@ -818,26 +1263,35 @@ done: 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 { - c = gfc_next_char_literal (0); + c = gfc_next_char_literal (NONSTRING); } 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 (); @@ -847,6 +1301,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 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 @@ -855,7 +1319,7 @@ gfc_peek_char (void) void gfc_error_recovery (void) { - char c, delim; + gfc_char_t c, delim; if (gfc_at_eof ()) return; @@ -902,22 +1366,18 @@ gfc_gobble_whitespace (void) { static int linenum = 0; locus old_loc; - int c; + gfc_char_t c; do { old_loc = gfc_current_locus; - c = gfc_next_char_literal (0); + c = gfc_next_char_literal (NONSTRING); /* Issue a warning for nonconforming tabs. We keep track of the line number because the Fortran matchers will often back up and the same line will be scanned multiple times. */ if (!gfc_option.warn_tabs && c == '\t') { -#ifdef USE_MAPPED_LOCATION int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location); -#else - int cur_linenum = gfc_current_locus.lb->linenum; -#endif if (cur_linenum != linenum) { linenum = cur_linenum; @@ -941,6 +1401,11 @@ gfc_gobble_whitespace (void) In fixed mode, we expand a tab that occurs within the statement label region to expand to spaces that leave the next character in the source region. + + If first_char is not NULL, it's a pointer to a single char value holding + the first character of the line, which has already been read by the + caller. This avoids the use of ungetc(). + load_line returns whether the line was truncated. NOTE: The error machinery isn't available at this point, so we can't @@ -948,13 +1413,14 @@ gfc_gobble_whitespace (void) parts of gfortran. */ static int -load_line (FILE * input, char **pbuf, int *pbuflen) +load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) { 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; + int seen_printable = 0, seen_ampersand = 0, quoted = ' '; + gfc_char_t *buffer; + bool found_tab = false; /* Determine the maximum allowed line length. */ if (gfc_current_form == FORM_FREE) @@ -976,95 +1442,106 @@ load_line (FILE * input, char **pbuf, int *pbuflen) else buflen = 132; - *pbuf = gfc_getmem (buflen + 1); + *pbuf = gfc_get_wide_string (buflen + 1); } i = 0; buffer = *pbuf; - preprocessor_flag = 0; - c = fgetc (input); - if (c == '#') - /* In order to not truncate preprocessor lines, we have to - remember that this is one. */ - preprocessor_flag = 1; - ungetc (c, input); + if (first_char) + c = *first_char; + else + c = getc (input); + + /* In order to not truncate preprocessor lines, we have to + remember that this is one. */ + preprocessor_flag = (c == '#' ? 1 : 0); for (;;) { - c = fgetc (input); - if (c == EOF) break; + if (c == '\n') { /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */ if (gfc_current_form == FORM_FREE - && !seen_printable && seen_ampersand) + && !seen_printable && seen_ampersand) { if (pedantic) - gfc_error_now - ("'&' not allowed by itself in line %d", current_line); + gfc_error_now ("'&' not allowed by itself in line %d", + current_line); else - gfc_warning_now - ("'&' not allowed by itself in line %d", current_line); + gfc_warning_now ("'&' not allowed by itself in line %d", + current_line); } break; } - if (c == '\r') - continue; /* Gobble characters. */ - if (c == '\0') - continue; - - if (c == '\032') - { - /* Ctrl-Z ends the file. */ - while (fgetc (input) != EOF); - break; - } + if (c == '\r' || c == '\0') + goto next_char; /* Gobble characters. */ - /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */ if (c == '&') - seen_ampersand = 1; - - if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand)) - seen_printable = 1; - - if (gfc_current_form == FORM_FREE - && c == '!' && !seen_printable && seen_ampersand) { - if (pedantic) - gfc_error_now ( - "'&' not allowed by itself with comment in line %d", current_line); + if (seen_ampersand) + { + seen_ampersand = 0; + seen_printable = 1; + } else - gfc_warning_now ( - "'&' not allowed by itself with comment in line %d", current_line); - seen_printable = 1; + seen_ampersand = 1; } + if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand)) + seen_printable = 1; + /* Is this a fixed-form comment? */ if (gfc_current_form == FORM_FIXED && i == 0 && (c == '*' || c == 'c' || c == 'd')) seen_comment = 1; - if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6) + if (quoted == ' ') + { + if (c == '\'' || c == '"') + quoted = c; + } + else if (c == quoted) + quoted = ' '; + + /* Is this a free-form comment? */ + if (c == '!' && quoted == ' ') + seen_comment = 1; + + /* Vendor extension: "1" marks a continuation line. */ + if (found_tab) + { + found_tab = false; + if (c >= '1' && c <= '9') + { + *(buffer-1) = c; + goto next_char; + } + } + + if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6) { + found_tab = true; + if (!gfc_option.warn_tabs && seen_comment == 0 && current_line != linenum) { linenum = current_line; - gfc_warning_now ( - "Nonconforming tab character in column 1 of line %d", linenum); + gfc_warning_now ("Nonconforming tab character in column %d " + "of line %d", i+1, linenum); } - while (i <= 6) + while (i < 6) { *buffer++ = ' '; i++; } - continue; + goto next_char; } *buffer++ = c; @@ -1077,24 +1554,48 @@ load_line (FILE * input, char **pbuf, int *pbuflen) /* Reallocate line buffer to double size to hold the overlong line. */ buflen = buflen * 2; - *pbuf = xrealloc (*pbuf, buflen + 1); - buffer = (*pbuf)+i; + *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1)); + buffer = (*pbuf) + i; } } else if (i >= maxlen) { + bool trunc_warn = true; + + /* Enhancement, if the very next non-space character is an ampersand + or comment that we would otherwise warn about, don't mark as + truncated. */ + /* Truncate the rest of the line. */ for (;;) { - c = fgetc (input); + c = getc (input); + if (c == '\r' || c == ' ') + continue; + if (c == '\n' || c == EOF) break; - trunc_flag = 1; + if (!trunc_warn && c != '!') + trunc_warn = true; + + if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&') + || c == '!')) + trunc_warn = false; + + if (c == '!') + seen_comment = 1; + + if (trunc_warn && !seen_comment) + trunc_flag = 1; } - ungetc ('\n', input); + c = '\n'; + continue; } + +next_char: + c = getc (input); } /* Pad lines to the selected line length in fixed form. */ @@ -1123,36 +1624,35 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED) { gfc_file *f; - f = gfc_getmem (sizeof (gfc_file)); + f = XCNEW (gfc_file); - f->filename = gfc_getmem (strlen (name) + 1); - strcpy (f->filename, name); + f->filename = xstrdup (name); f->next = file_head; file_head = f; - f->included_by = current_file; + f->up = current_file; if (current_file != NULL) f->inclusion_line = current_file->line; -#ifdef USE_MAPPED_LOCATION - linemap_add (&line_table, reason, false, f->filename, 1); -#endif + linemap_add (line_table, reason, false, f->filename, 1); 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') @@ -1161,9 +1661,9 @@ preprocessor_line (char *c) 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. */ @@ -1180,15 +1680,15 @@ preprocessor_line (char *c) goto bad_cpp_line; ++c; - filename = c; + wide_filename = c; /* Make filename end at quote. */ unescape = 0; escaped = false; - while (*c && ! (! escaped && *c == '"')) + while (*c && ! (!escaped && *c == '"')) { if (escaped) - escaped = false; + escaped = false; else if (*c == '\\') { escaped = true; @@ -1206,10 +1706,10 @@ preprocessor_line (char *c) /* 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_get_wide_string (c - wide_filename - unescape); - filename = d; + wide_filename = d; while (*s) { if (*s == '\\') @@ -1227,23 +1727,27 @@ preprocessor_line (char *c) 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 = gfc_widechar_to_char (wide_filename, -1); + /* Interpret flags. */ if (flag[1]) /* Starting new file. */ { f = get_file (filename, LC_RENAME); - f->up = current_file; + add_file_change (f->filename, f->inclusion_line); current_file = f; } @@ -1256,10 +1760,15 @@ preprocessor_line (char *c) current_file->filename, current_file->line, filename); if (unescape) - gfc_free (filename); + gfc_free (wide_filename); + gfc_free (filename); return; } + + add_file_change (NULL, line); current_file = current_file->up; + linemap_add (line_table, LC_RENAME, false, current_file->filename, + current_file->line); } /* The name of the file can be a temporary file produced by @@ -1267,15 +1776,17 @@ preprocessor_line (char *c) if (strcmp (current_file->filename, filename) != 0) { - gfc_free (current_file->filename); - current_file->filename = gfc_getmem (strlen (filename) + 1); - strcpy (current_file->filename, filename); + /* FIXME: we leak the old filename because a pointer to it may be stored + in the linemap. Alternative could be using GC or updating linemap to + point to the new name, but there is no API for that currently. */ + current_file->filename = xstrdup (filename); } /* Set new line number. */ current_file->line = line; if (unescape) - gfc_free (filename); + gfc_free (wide_filename); + gfc_free (filename); return; bad_cpp_line: @@ -1285,7 +1796,7 @@ preprocessor_line (char *c) } -static try load_file (const char *, bool); +static gfc_try load_file (const char *, const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included @@ -1294,13 +1805,14 @@ static try load_file (const char *, bool); 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; - if (gfc_option.flag_openmp) + if (gfc_option.gfc_flag_openmp) { if (gfc_current_form == FORM_FREE) { @@ -1320,8 +1832,8 @@ include_line (char *line) while (*c == ' ' || *c == '\t') c++; - if (strncasecmp (c, "include", 7)) - return false; + if (gfc_wide_strncasecmp (c, "include", 7)) + return false; c += 7; while (*c == ' ' || *c == '\t') @@ -1354,25 +1866,36 @@ include_line (char *line) *stop = '\0'; /* It's ok to trash the buffer, as this line won't be read by anything else. */ - load_file (begin, false); + filename = gfc_widechar_to_char (begin, -1); + if (load_file (filename, NULL, false) == FAILURE) + exit (1); + + gfc_free (filename); return true; } + /* Load a file into memory by calling load_line until the file ends. */ -static try -load_file (const char *filename, bool initial) +static gfc_try +load_file (const char *realfilename, const char *displayedname, bool initial) { - char *line; + gfc_char_t *line; gfc_linebuf *b; gfc_file *f; FILE *input; int len, line_len; + bool first_line; + const char *filename; + + filename = displayedname ? displayedname : realfilename; for (f = current_file; f; f = f->up) if (strcmp (filename, f->filename) == 0) { - gfc_error_now ("File '%s' is being included recursively", filename); + fprintf (stderr, "%s:%d: Error: File '%s' is being included " + "recursively\n", current_file->filename, current_file->line, + filename); return FAILURE; } @@ -1384,7 +1907,7 @@ load_file (const char *filename, bool initial) gfc_src_file = NULL; } else - input = gfc_open_file (filename); + input = gfc_open_file (realfilename); if (input == NULL) { gfc_error_now ("Can't open file '%s'", filename); @@ -1393,10 +1916,11 @@ load_file (const char *filename, bool initial) } else { - input = gfc_open_included_file (filename, false); + input = gfc_open_included_file (realfilename, false, false); if (input == NULL) { - gfc_error_now ("Can't open included file '%s'", filename); + fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n", + current_file->filename, current_file->line, filename); return FAILURE; } } @@ -1404,11 +1928,13 @@ load_file (const char *filename, bool initial) /* Load the file. */ f = get_file (filename, initial ? LC_RENAME : LC_ENTER); - f->up = current_file; + if (!initial) + add_file_change (f->filename, f->inclusion_line); current_file = f; current_file->line = 1; line = NULL; line_len = 0; + first_line = true; if (initial && gfc_src_preprocessor_lines[0]) { @@ -1425,21 +1951,59 @@ load_file (const char *filename, bool initial) for (;;) { - int trunc = load_line (input, &line, &line_len); + int trunc = load_line (input, &line, &line_len, NULL); - len = strlen (line); + len = gfc_wide_strlen (line); if (feof (input) && len == 0) break; + /* If this is the first line of the file, it can contain a byte + order mark (BOM), which we will ignore: + FF FE is UTF-16 little endian, + FE FF is UTF-16 big endian, + EF BB BF is UTF-8. */ + if (first_line + && ((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] == (unsigned char) '\xBB' ? 3 : 2; + gfc_char_t *new_char = gfc_get_wide_string (line_len); + + wide_strcpy (new_char, &line[n]); + gfc_free (line); + line = new_char; + len -= n; + } + /* There are three things this line can be: a line of Fortran source, an include line or a C preprocessor directive. */ if (line[0] == '#') { - preprocessor_line (line); - continue; + /* When -g3 is specified, it's possible that we emit #define + 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 + && (wide_strncmp (line, "#define ", 8) == 0 + || wide_strncmp (line, "#undef ", 7) == 0)) + ; + else + { + preprocessor_line (line); + continue; + } } + /* Preprocessed files have preprocessor lines added before the byte + order mark, so first_line is not about the first line of the file + but the first line that's not a preprocessor line. */ + first_line = false; + if (include_line (line)) { current_file->line++; @@ -1448,17 +2012,14 @@ load_file (const char *filename, bool initial) /* Add line. */ - b = gfc_getmem (gfc_linebuf_header_size + len + 1); + b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size + + (len + 1) * sizeof (gfc_char_t)); -#ifdef USE_MAPPED_LOCATION b->location - = linemap_line_start (&line_table, current_file->line++, 120); -#else - b->linenum = current_file->line++; -#endif + = 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; @@ -1466,6 +2027,9 @@ load_file (const char *filename, bool initial) line_tail->next = b; line_tail = b; + + while (file_changes_cur < file_changes_count) + file_changes[file_changes_cur++].lb = b; } /* Release the line buffer allocated in load_line. */ @@ -1473,38 +2037,40 @@ load_file (const char *filename, bool initial) fclose (input); + if (!initial) + add_file_change (NULL, current_file->inclusion_line + 1); current_file = current_file->up; -#ifdef USE_MAPPED_LOCATION - linemap_add (&line_table, LC_LEAVE, 0, NULL, 0); -#endif + linemap_add (line_table, LC_LEAVE, 0, NULL, 0); return SUCCESS; } /* Open a new file and start scanning from that file. Returns SUCCESS - if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN + if everything went OK, FAILURE otherwise. If form == FORM_UNKNOWN it tries to determine the source form from the filename, defaulting to free form. */ -try +gfc_try gfc_new_file (void) { - try result; + gfc_try result; - result = load_file (gfc_source_file, true); + if (gfc_cpp_enabled ()) + { + result = gfc_cpp_preprocess (gfc_source_file); + if (!gfc_cpp_preprocess_only ()) + result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true); + } + else + result = load_file (gfc_source_file, NULL, true); gfc_current_locus.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; #if 0 /* Debugging aid. */ for (; line_head; line_head = line_head->next) - gfc_status ("%s:%3d %s\n", line_head->file->filename, -#ifdef USE_MAPPED_LOCATION - LOCATION_LINE (line_head->location), -#else - line_head->linenum, -#endif - line_head->line); + printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location), + LOCATION_LINE (line_head->location), line_head->line); exit (0); #endif @@ -1533,12 +2099,12 @@ unescape_filename (const char *ptr) ++p; } - if (! *p || p[1]) + if (!*p || p[1]) return NULL; /* Undo effects of cpp_quote_string. */ s = ptr; - d = gfc_getmem (p + 1 - ptr - unescape); + d = XCNEWVEC (char, p + 1 - ptr - unescape); ret = d; while (s != p) @@ -1560,41 +2126,43 @@ const char * 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) return NULL; - c = fgetc (gfc_src_file); - ungetc (c, gfc_src_file); + c = getc (gfc_src_file); if (c != '#') return NULL; len = 0; - load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len); + load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c); - 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 = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1); + filename = unescape_filename (tmp); + gfc_free (tmp); if (filename == NULL) return NULL; - c = fgetc (gfc_src_file); - ungetc (c, gfc_src_file); + c = getc (gfc_src_file); if (c != '#') return filename; len = 0; - load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len); + load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c); - 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 = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1); + dirname = unescape_filename (tmp); + gfc_free (tmp); if (dirname == NULL) return filename; @@ -1609,7 +2177,7 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) if (! IS_ABSOLUTE_PATH (filename)) { - char *p = gfc_getmem (len + strlen (filename)); + char *p = XCNEWVEC (char, len + strlen (filename)); memcpy (p, dirname, len - 2); p[len - 2] = '/';