2018-11-21 Jakub Jelinek Mark Eggleston * lang.opt (fdec-include): New option. * options.c (set_dec_flags): Set also flag_dec_include. * scanner.c (include_line): Change return type from bool to int. In fixed form allow spaces in between include keyword letters. For -fdec-include, allow in fixed form 0 in column 6. With -fdec-include return -1 if the parsed line is not full include statement and it could be successfully completed on continuation lines. (include_stmt): New function. (load_file): Adjust include_line caller. If it returns -1, keep trying include_stmt until it stops returning -1 whenever adding further line of input. --- gcc/fortran/lang.opt +++ gcc/fortran/lang.opt @@ -432,6 +432,10 @@ fdec-pad-with-spaces Fortran Var(flag_dec_pad_with_spaces) For character to integer conversions, use spaces for the pad rather than NUL. +fdec-include +Fortran Var(flag_dec_include) +Enable legacy parsing of INCLUDE as statement. + fdec-intrinsic-ints Fortran Var(flag_dec_intrinsic_ints) Enable kind-specific variants of integer intrinsic functions. --- gcc/fortran/options.c +++ gcc/fortran/options.c @@ -68,6 +68,7 @@ set_dec_flags (int value) flag_dec_intrinsic_ints |= value; flag_dec_static |= value; flag_dec_math |= value; + flag_dec_include |= value; } --- gcc/fortran/scanner.c +++ gcc/fortran/scanner.c @@ -2135,14 +2135,18 @@ static bool 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 file. We never return a syntax error because a statement like - "include = 5" is perfectly legal. We return false if no include was - processed or true if we matched an include. */ + "include = 5" is perfectly legal. We return 0 if no include was + processed, 1 if we matched an include or -1 if include was + partially processed, but will need continuation lines. */ -static bool +static int include_line (gfc_char_t *line) { gfc_char_t quote, *c, *begin, *stop; char *filename; + const char *include = "include"; + bool allow_continuation = flag_dec_include; + int i; c = line; @@ -2158,42 +2162,133 @@ include_line (gfc_char_t *line) else { if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*') - && c[1] == '$' && (c[2] == ' ' || c[2] == '\t')) + && c[1] == '$' && c[2] == ' ') c += 3; } } - while (*c == ' ' || *c == '\t') - c++; + if (gfc_current_form == FORM_FREE) + { + while (*c == ' ' || *c == '\t') + c++; + if (gfc_wide_strncasecmp (c, "include", 7)) + { + if (!allow_continuation) + return 0; + for (i = 0; i < 7; ++i) + { + gfc_char_t c1 = gfc_wide_tolower (*c); + if (c1 != (unsigned char) include[i]) + break; + c++; + } + if (i == 0 || *c != '&') + return 0; + c++; + while (*c == ' ' || *c == '\t') + c++; + if (*c == '\0' || *c == '!') + return -1; + return 0; + } - if (gfc_wide_strncasecmp (c, "include", 7)) - return false; + c += 7; + } + else + { + while (*c == ' ' || *c == '\t') + c++; + if (flag_dec_include && *c == '0' && c - line == 5) + { + c++; + while (*c == ' ' || *c == '\t') + c++; + } + if (c - line < 6) + allow_continuation = false; + for (i = 0; i < 7; ++i) + { + gfc_char_t c1 = gfc_wide_tolower (*c); + if (c1 != (unsigned char) include[i]) + break; + c++; + while (*c == ' ' || *c == '\t') + c++; + } + if (!allow_continuation) + { + if (i != 7) + return 0; + } + else if (i != 7) + { + if (i == 0) + return 0; + + /* At the end of line or comment this might be continued. */ + if (*c == '\0' || *c == '!') + return -1; + + return 0; + } + } - c += 7; while (*c == ' ' || *c == '\t') c++; /* Find filename between quotes. */ - + quote = *c++; if (quote != '"' && quote != '\'') - return false; + { + if (allow_continuation) + { + if (gfc_current_form == FORM_FREE) + { + if (quote == '&') + { + while (*c == ' ' || *c == '\t') + c++; + if (*c == '\0' || *c == '!') + return -1; + } + } + else if (quote == '\0' || quote == '!') + return -1; + } + return 0; + } begin = c; + bool cont = false; while (*c != quote && *c != '\0') - c++; + { + if (allow_continuation && gfc_current_form == FORM_FREE) + { + if (*c == '&') + cont = true; + else if (*c != ' ' && *c != '\t') + cont = false; + } + c++; + } if (*c == '\0') - return false; + { + if (allow_continuation + && (cont || gfc_current_form != FORM_FREE)) + return -1; + return 0; + } stop = c++; - + while (*c == ' ' || *c == '\t') c++; if (*c != '\0' && *c != '!') - return false; + return 0; /* We have an include line at this point. */ @@ -2205,9 +2300,130 @@ include_line (gfc_char_t *line) exit (FATAL_EXIT_CODE); free (filename); - return true; + return 1; } +/* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc. + APIs. Return 1 if recognized as valid INCLUDE statement and load_file has + been called, 0 if it is not a valid INCLUDE statement and -1 if eof has + been encountered while parsing it. */ +static int +include_stmt (gfc_linebuf *b) +{ + int ret = 0, i, length; + const char *include = "include"; + gfc_char_t c, quote = 0; + locus str_locus; + char *filename; + + continue_flag = 0; + end_flag = 0; + gcc_attribute_flag = 0; + openmp_flag = 0; + openacc_flag = 0; + continue_count = 0; + continue_line = 0; + gfc_current_locus.lb = b; + gfc_current_locus.nextc = b->line; + + gfc_skip_comments (); + gfc_gobble_whitespace (); + + for (i = 0; i < 7; i++) + { + c = gfc_next_char (); + if (c != (unsigned char) include[i]) + { + if (gfc_current_form == FORM_FIXED + && i == 0 + && c == '0' + && gfc_current_locus.nextc == b->line + 6) + { + gfc_gobble_whitespace (); + i--; + continue; + } + gcc_assert (i != 0); + if (c == '\n') + { + gfc_advance_line (); + gfc_skip_comments (); + if (gfc_at_eof ()) + ret = -1; + } + goto do_ret; + } + } + gfc_gobble_whitespace (); + + c = gfc_next_char (); + if (c == '\'' || c == '"') + quote = c; + else + { + if (c == '\n') + { + gfc_advance_line (); + gfc_skip_comments (); + if (gfc_at_eof ()) + ret = -1; + } + goto do_ret; + } + + str_locus = gfc_current_locus; + length = 0; + do + { + c = gfc_next_char_literal (INSTRING_NOWARN); + if (c == quote) + break; + if (c == '\n') + { + gfc_advance_line (); + gfc_skip_comments (); + if (gfc_at_eof ()) + ret = -1; + goto do_ret; + } + length++; + } + while (1); + + gfc_gobble_whitespace (); + c = gfc_next_char (); + if (c != '\n') + goto do_ret; + + gfc_current_locus = str_locus; + ret = 1; + filename = XNEWVEC (char, length + 1); + for (i = 0; i < length; i++) + { + c = gfc_next_char_literal (INSTRING_WARN); + gcc_assert (gfc_wide_fits_in_byte (c)); + filename[i] = (unsigned char) c; + } + filename[length] = '\0'; + if (!load_file (filename, NULL, false)) + exit (FATAL_EXIT_CODE); + + free (filename); + +do_ret: + continue_flag = 0; + end_flag = 0; + gcc_attribute_flag = 0; + openmp_flag = 0; + openacc_flag = 0; + continue_count = 0; + continue_line = 0; + memset (&gfc_current_locus, '\0', sizeof (locus)); + memset (&openmp_locus, '\0', sizeof (locus)); + memset (&openacc_locus, '\0', sizeof (locus)); + memset (&gcc_attribute_locus, '\0', sizeof (locus)); + return ret; +} /* Load a file into memory by calling load_line until the file ends. */ @@ -2215,7 +2431,7 @@ static bool load_file (const char *realfilename, const char *displayedname, bool initial) { gfc_char_t *line; - gfc_linebuf *b; + gfc_linebuf *b, *include_b = NULL; gfc_file *f; FILE *input; int len, line_len; @@ -2318,6 +2534,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) for (;;) { int trunc = load_line (input, &line, &line_len, NULL); + int inc_line; len = gfc_wide_strlen (line); if (feof (input) && len == 0) @@ -2366,11 +2583,12 @@ load_file (const char *realfilename, const char *displayedname, bool initial) } /* Preprocessed files have preprocessor lines added before the byte - order mark, so first_line is not about the first line of the file + 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)) + inc_line = include_line (line); + if (inc_line > 0) { current_file->line++; continue; @@ -2403,6 +2621,36 @@ load_file (const char *realfilename, const char *displayedname, bool initial) while (file_changes_cur < file_changes_count) file_changes[file_changes_cur++].lb = b; + + if (flag_dec_include) + { + if (include_b && b != include_b) + { + int inc_line2 = include_stmt (include_b); + if (inc_line2 == 0) + include_b = NULL; + else if (inc_line2 > 0) + { + do + { + if (gfc_current_form == FORM_FIXED) + { + for (gfc_char_t *p = include_b->line; *p; p++) + *p = ' '; + } + else + include_b->line[0] = '\0'; + if (include_b == b) + break; + include_b = include_b->next; + } + while (1); + include_b = NULL; + } + } + if (inc_line == -1 && !include_b) + include_b = b; + } } /* Release the line buffer allocated in load_line. */ --- /dev/null +++ gcc/testsuite/gfortran.dg/gomp/include_1.f @@ -0,0 +1,49 @@ +c { dg-do compile } +c { dg-options "-fopenmp -fdec" } + subroutine foo + implicit none +c$ 0include 'include_1.inc' + i = 1 + end subroutine foo + subroutine bar + implicit none + i +C$ ;n + +c + +c some comment + +*$ ll +C comment line + uu + DD + ee'include_1.inc' + i = 1 + end subroutine bar + subroutine baz + implicit none + 0include + + 'include_1.inc' + i = 1 + end subroutine baz + subroutine qux + implicit none +!$ i n C lude 'inc +* another comment line + &lude_1.inc' + i = 1 + end subroutine qux + subroutine quux + implicit none +C$ 0inc +*$ 1lud +c$ 2e ' +!$ 3include_1.inc' + i = 1 + end subroutine quux + program include_12 + implicit none + include +! comment +c$ +'include_1.inc' + end program --- /dev/null +++ gcc/testsuite/gfortran.dg/gomp/include_1.inc @@ -0,0 +1 @@ + integer i --- /dev/null +++ gcc/testsuite/gfortran.dg/gomp/include_2.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdec-include" } +subroutine foo + implicit none +!$ incl& ! comment1 +!$ &u& +!$ &de & ! comment2 +!$ 'include& + &_1.inc' + i = 1 +end subroutine foo +subroutine bar + implicit none +!$ include & + +! comment3 + +!$ "include_1.inc" + i = 1 +end subroutine bar +subroutine baz + implicit none +!$ include& +!$ &'include_1.& +!$ &inc' + i = 1 +end subroutine baz +subroutine qux + implicit none +!$ include '& +include_1.inc' +end subroutine qux --- /dev/null +++ gcc/testsuite/gfortran.dg/include_10.f @@ -0,0 +1,11 @@ +c { dg-do compile } + subroutine foo + implicit none + include 'include_10.inc' + i = 1 + end subroutine foo + subroutine bar + implicit none + i n cl UD e'include_10.inc' + i = 1 + end subroutine bar --- /dev/null +++ gcc/testsuite/gfortran.dg/include_10.inc @@ -0,0 +1 @@ + integer i --- /dev/null +++ gcc/testsuite/gfortran.dg/include_11.f @@ -0,0 +1,20 @@ +c { dg-do compile } + subroutine foo + implicit none +c We used to accept following in fixed mode. Shall we at least +c warn about it? +include 'include_10.inc' + i = 1 + end subroutine foo + subroutine bar +c Likewise here. + implicit none + include'include_10.inc' + i = 1 + end subroutine bar + subroutine baz +c And here. + implicit none + include 'include_10.inc' + i = 1 + end subroutine baz --- /dev/null +++ gcc/testsuite/gfortran.dg/include_12.f @@ -0,0 +1,65 @@ +c { dg-do compile } +c { dg-options "-fdec-include" } + subroutine foo + implicit none + 0include 'include_10.inc' + i = 1 + end subroutine foo + subroutine bar + implicit none + i + ;n + +c + +c some comment + + ll +C comment line + uu + DD + ee'include_10.inc' + i = 1 + end subroutine bar + subroutine baz + implicit none + 0include + + 'include_10.inc' + i = 1 + end subroutine baz + subroutine qux + implicit none + i n C lude 'inc +* another comment line + &lude_10.inc' + i = 1 + end subroutine qux + subroutine quux + implicit none + 0inc + 1lud + 2e ' + 3include_10.inc' + i = 1 + end subroutine quux + program include_12 + implicit none + include +! comment + +'include_10.inc' + end program + subroutine quuz + implicit none + integer include + include + +"include_10.inc" + i = 1 + include + + = 2 + write (*,*) include + end subroutine quuz + subroutine corge + implicit none + include + +'include_10.inc' + i = 1 + end subroutine corge --- /dev/null +++ gcc/testsuite/gfortran.dg/include_13.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! { dg-options "-fdec" } +subroutine foo + implicit none + incl& ! comment1 +&u& + &de & ! comment2 +'include& + &_10.inc' + i = 1 +end subroutine foo +subroutine bar + implicit none +include & + +! comment3 + +"include_10.inc" + i = 1 +end subroutine bar +subroutine baz + implicit none + include& +&'include_10.& +&inc' + i = 1 +end subroutine baz +subroutine qux + implicit none + include '& +include_10.inc' +end subroutine qux +subroutine quux + implicit none + include & + &'include_10.inc' + i = 1 +end subroutine quux +subroutine quuz + implicit none + include & + &"include_10.inc" + i = 1 +end subroutine quuz