X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Fscanner.c;h=0c127d49e02d434886daabdc07c136bb2a9ec406;hb=ccd3dcb6fb0fb5c9e11e56556c0e6b2233ee8391;hp=8c702ca3f3382a8a659181f5f6b6b779e11ddd70;hpb=f6bb8f4b22e28208957085201fe0260f0fa7f357;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 8c702ca3f33..0c127d49e02 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1,6 +1,6 @@ /* Character scanner. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 - 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. @@ -44,7 +44,7 @@ along with GCC; see the file COPYING3. If not see #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" @@ -63,9 +63,10 @@ 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; @@ -75,8 +76,6 @@ const char *gfc_source_file; static FILE *gfc_src_file; static gfc_char_t *gfc_src_preprocessor_lines[2]; -extern int pedantic; - static struct gfc_file_change { const char *filename; @@ -289,15 +288,15 @@ gfc_scanner_done_1 (void) while(line_head != NULL) { lb = line_head->next; - gfc_free(line_head); + free (line_head); line_head = lb; } while(file_head != NULL) { f = file_head->next; - gfc_free(file_head->filename); - gfc_free(file_head); + free (file_head->filename); + free (file_head); file_head = f; } } @@ -307,7 +306,7 @@ gfc_scanner_done_1 (void) static void add_path_to_list (gfc_directorylist **list, const char *path, - bool use_for_modules) + bool use_for_modules, bool head) { gfc_directorylist *dir; const char *p; @@ -317,11 +316,15 @@ add_path_to_list (gfc_directorylist **list, const char *path, if (*p++ == '\0') return; - dir = *list; - if (!dir) - dir = *list = XCNEW (gfc_directorylist); + if (head || *list == NULL) + { + dir = XCNEW (gfc_directorylist); + if (!head) + *list = dir; + } else { + dir = *list; while (dir->next) dir = dir->next; @@ -329,7 +332,9 @@ add_path_to_list (gfc_directorylist **list, const char *path, dir = dir->next; } - dir->next = NULL; + 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); @@ -338,17 +343,20 @@ add_path_to_list (gfc_directorylist **list, const char *path, void -gfc_add_include_path (const char *path, bool use_for_modules) +gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir) { - add_path_to_list (&include_dirs, path, use_for_modules); - gfc_cpp_add_include_path (xstrdup(path), true); + 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); + add_path_to_list (&intrinsic_modules_dirs, path, true, false); } @@ -363,24 +371,25 @@ gfc_release_include_path (void) { p = include_dirs; include_dirs = include_dirs->next; - gfc_free (p->path); - gfc_free (p); + free (p->path); + 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); + free (p->path); + free (p); } - gfc_free (gfc_option.module_dir); + free (gfc_option.module_dir); } static FILE * -open_included_file (const char *name, gfc_directorylist *list, bool module) +open_included_file (const char *name, gfc_directorylist *list, + bool module, bool system) { char *fullname; gfc_directorylist *p; @@ -397,7 +406,12 @@ open_included_file (const char *name, gfc_directorylist *list, bool module) f = gfc_open_file (fullname); if (f != NULL) - return f; + { + if (gfc_cpp_makedep ()) + gfc_cpp_add_dep (fullname, system); + + return f; + } } return NULL; @@ -411,28 +425,37 @@ open_included_file (const char *name, gfc_directorylist *list, bool module) FILE * gfc_open_included_file (const char *name, bool include_cwd, bool module) { - FILE *f; + FILE *f = NULL; - if (IS_ABSOLUTE_PATH (name)) - return gfc_open_file (name); - - if (include_cwd) + if (IS_ABSOLUTE_PATH (name) || include_cwd) { f = gfc_open_file (name); - if (f != NULL) - return f; + if (f && gfc_cpp_makedep ()) + gfc_cpp_add_dep (name, false); } - return open_included_file (name, include_dirs, module); + 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)) - return gfc_open_file (name); + { + f = gfc_open_file (name); + if (f && gfc_cpp_makedep ()) + gfc_cpp_add_dep (name, true); + } - return open_included_file (name, intrinsic_modules_dirs, true); + if (!f) + f = open_included_file (name, intrinsic_modules_dirs, true, true); + + return f; } @@ -604,7 +627,7 @@ next_char (void) /* 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 @@ -636,7 +659,7 @@ gfc_define_undef_line (void) 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); + free (tmp); } if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0) @@ -644,7 +667,7 @@ gfc_define_undef_line (void) 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); + free (tmp); } /* Skip the rest of the line. */ @@ -654,6 +677,34 @@ gfc_define_undef_line (void) } +/* 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 @@ -685,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 () == '$') @@ -743,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; } @@ -797,6 +854,13 @@ 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 @@ -807,7 +871,7 @@ skip_fixed_comments (void) && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); - if (gfc_option.flag_openmp) + if (gfc_option.gfc_flag_openmp) { if (next_char () == '$') { @@ -908,6 +972,7 @@ skip_fixed_comments (void) } openmp_flag = 0; + gcc_attribute_flag = 0; gfc_current_locus = start; } @@ -932,7 +997,7 @@ gfc_skip_comments (void) context or not. */ gfc_char_t -gfc_next_char_literal (int in_string) +gfc_next_char_literal (gfc_instring in_string) { locus old_loc; int i, prev_openmp_flag; @@ -954,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) @@ -972,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; @@ -1065,10 +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. */ @@ -1082,7 +1163,7 @@ restart: } } } - else + else /* Fixed form. */ { /* Fixed form continuation. */ if (!in_string && c == '!') @@ -1101,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; @@ -1181,7 +1270,7 @@ gfc_next_char (void) do { - c = gfc_next_char_literal (0); + c = gfc_next_char_literal (NONSTRING); } while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c)); @@ -1282,7 +1371,7 @@ gfc_gobble_whitespace (void) 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. */ @@ -1329,7 +1418,7 @@ 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; + int seen_printable = 0, seen_ampersand = 0, quoted = ' '; gfc_char_t *buffer; bool found_tab = false; @@ -1395,7 +1484,10 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) if (c == '&') { if (seen_ampersand) - seen_ampersand = 0; + { + seen_ampersand = 0; + seen_printable = 1; + } else seen_ampersand = 1; } @@ -1408,6 +1500,18 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) && (c == '*' || c == 'c' || c == 'd')) seen_comment = 1; + 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) { @@ -1456,14 +1560,34 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) } 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 = 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; } c = '\n'; @@ -1630,14 +1754,14 @@ preprocessor_line (gfc_char_t *c) if (flag[2]) /* Ending current file. */ { if (!current_file->up - || strcmp (current_file->up->filename, filename) != 0) + || filename_cmp (current_file->up->filename, filename) != 0) { gfc_warning_now ("%s:%d: file %s left but not entered", current_file->filename, current_file->line, filename); if (unescape) - gfc_free (wide_filename); - gfc_free (filename); + free (wide_filename); + free (filename); return; } @@ -1650,7 +1774,7 @@ preprocessor_line (gfc_char_t *c) /* The name of the file can be a temporary file produced by cpp. Replace the name if it is different. */ - if (strcmp (current_file->filename, filename) != 0) + if (filename_cmp (current_file->filename, filename) != 0) { /* 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 @@ -1661,8 +1785,8 @@ preprocessor_line (gfc_char_t *c) /* Set new line number. */ current_file->line = line; if (unescape) - gfc_free (wide_filename); - gfc_free (filename); + free (wide_filename); + free (filename); return; bad_cpp_line: @@ -1688,7 +1812,7 @@ include_line (gfc_char_t *line) c = line; - if (gfc_option.flag_openmp) + if (gfc_option.gfc_flag_openmp) { if (gfc_current_form == FORM_FREE) { @@ -1743,8 +1867,10 @@ include_line (gfc_char_t *line) read by anything else. */ filename = gfc_widechar_to_char (begin, -1); - load_file (filename, NULL, false); - gfc_free (filename); + if (load_file (filename, NULL, false) == FAILURE) + exit (FATAL_EXIT_CODE); + + free (filename); return true; } @@ -1765,9 +1891,11 @@ load_file (const char *realfilename, const char *displayedname, bool initial) filename = displayedname ? displayedname : realfilename; for (f = current_file; f; f = f->up) - if (strcmp (filename, f->filename) == 0) + if (filename_cmp (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; } @@ -1791,7 +1919,8 @@ load_file (const char *realfilename, const char *displayedname, bool initial) 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; } } @@ -1810,12 +1939,12 @@ load_file (const char *realfilename, const char *displayedname, bool initial) if (initial && gfc_src_preprocessor_lines[0]) { preprocessor_line (gfc_src_preprocessor_lines[0]); - gfc_free (gfc_src_preprocessor_lines[0]); + free (gfc_src_preprocessor_lines[0]); gfc_src_preprocessor_lines[0] = NULL; if (gfc_src_preprocessor_lines[1]) { preprocessor_line (gfc_src_preprocessor_lines[1]); - gfc_free (gfc_src_preprocessor_lines[1]); + free (gfc_src_preprocessor_lines[1]); gfc_src_preprocessor_lines[1] = NULL; } } @@ -1846,7 +1975,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) gfc_char_t *new_char = gfc_get_wide_string (line_len); wide_strcpy (new_char, &line[n]); - gfc_free (line); + free (line); line = new_char; len -= n; } @@ -1883,8 +2012,8 @@ load_file (const char *realfilename, const char *displayedname, bool initial) /* Add line. */ - b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size - + (len + 1) * sizeof (gfc_char_t)); + b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size + + (len + 1) * sizeof (gfc_char_t)); b->location = linemap_line_start (line_table, current_file->line++, 120); @@ -1904,7 +2033,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) } /* Release the line buffer allocated in load_line. */ - gfc_free (line); + free (line); fclose (input); @@ -1943,7 +2072,7 @@ gfc_new_file (void) printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location), LOCATION_LINE (line_head->location), line_head->line); - exit (0); + exit (SUCCESS_EXIT_CODE); #endif return result; @@ -2016,7 +2145,7 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1); filename = unescape_filename (tmp); - gfc_free (tmp); + free (tmp); if (filename == NULL) return NULL; @@ -2033,14 +2162,14 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1); dirname = unescape_filename (tmp); - gfc_free (tmp); + free (tmp); if (dirname == NULL) return filename; len = strlen (dirname); if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/') { - gfc_free (dirname); + free (dirname); return filename; } dirname[len - 2] = '\0'; @@ -2056,6 +2185,6 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) *canon_source_file = p; } - gfc_free (dirname); + free (dirname); return filename; }