diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h index 5e194d0ac22f..aedf3ddfd2d1 100644 --- a/flang/lib/parser/grammar.h +++ b/flang/lib/parser/grammar.h @@ -157,7 +157,7 @@ template inline constexpr auto indirect(const PA &p) { } // R711 digit-string -> digit [digit]... -// N.B. not a token -- no spaces are skipped +// N.B. not a token -- no space is skipped constexpr auto digitString = DigitString{}; // statement(p) parses Statement

for some statement type P that is the @@ -165,20 +165,20 @@ constexpr auto digitString = DigitString{}; // end-of-statement markers. // R611 label -> digit [digit]... -constexpr auto label = spaces >> digitString / spaceCheck; +constexpr auto label = space >> digitString / spaceCheck; template using statementConstructor = construct>; template inline constexpr auto unterminatedStatement(const PA &p) { return skipEmptyLines >> - sourced(statementConstructor{}(maybe(label), spaces >> p)); + sourced(statementConstructor{}(maybe(label), space >> p)); } constexpr auto endOfLine = "\n"_ch / skipEmptyLines || fail("expected end of line"_en_US); -constexpr auto endOfStmt = spaces >> +constexpr auto endOfStmt = space >> (";"_ch / skipMany(";"_tok) / maybe(endOfLine) || endOfLine); template inline constexpr auto statement(const PA &p) { @@ -186,7 +186,7 @@ template inline constexpr auto statement(const PA &p) { } constexpr auto ignoredStatementPrefix = skipEmptyLines >> - maybe(label) >> spaces; + (label >> ok || space); // Error recovery within statements: skip to the end of the line, // but not over an END or CONTAINS statement. @@ -461,7 +461,7 @@ constexpr auto actionStmt = construct{}( construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || - "FAIL IMAGE" >> construct{}(construct{}) || + "FAIL~IMAGE" >> construct{}(construct{}) || construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || construct{}(indirect(Parser{})) || @@ -595,7 +595,7 @@ constexpr auto underscore = "_"_ch; constexpr auto otherIdChar = underscore / !"'\""_ch || extension("$@"_ch); constexpr auto nonDigitIdChar = letter || otherIdChar; constexpr auto rawName = nonDigitIdChar >> many(nonDigitIdChar || digit); -TYPE_PARSER(spaces >> sourced(attempt(rawName) >> construct{})) +TYPE_PARSER(space >> sourced(attempt(rawName) >> construct{})) constexpr auto keyword = construct{}(name); // R605 literal-constant -> @@ -603,7 +603,7 @@ constexpr auto keyword = construct{}(name); // complex-literal-constant | logical-literal-constant | // char-literal-constant | boz-literal-constant TYPE_PARSER(construct{}(Parser{}) || - construct{}(spaces >> realLiteralConstant) || + construct{}(space >> realLiteralConstant) || construct{}(intLiteralConstant) || construct{}(Parser{}) || construct{}(Parser{}) || @@ -696,10 +696,10 @@ TYPE_PARSER(construct{}("INTEGER" >> maybe(kindSelector))) TYPE_PARSER(construct{}( parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) || extension(construct{}( - construct{}("*" >> digitString)))) + construct{}("*" >> digitString / spaceCheck)))) // R710 signed-digit-string -> [sign] digit-string -// N.B. Not a complete token -- no spaces are skipped. +// N.B. Not a complete token -- no space is skipped. static inline std::int64_t negate(std::uint64_t &&n) { return -n; // TODO: check for overflow } @@ -713,15 +713,17 @@ constexpr auto signedDigitString = "-"_ch >> maybe("+"_ch) >> applyFunction(castToSigned, digitString); // R707 signed-int-literal-constant -> [sign] int-literal-constant -TYPE_PARSER(spaces >> sourced(construct{}( - signedDigitString, maybe(underscore >> kindParam)))) +TYPE_PARSER(space >> sourced(construct{}( + signedDigitString, maybe(underscore >> kindParam))) / + spaceCheck) // R708 int-literal-constant -> digit-string [_ kind-param] TYPE_PARSER(construct{}( - spaces >> digitString, maybe(underscore >> kindParam))) + space >> digitString, maybe(underscore >> kindParam)) / + spaceCheck) // R709 kind-param -> digit-string | scalar-int-constant-name -TYPE_PARSER(construct{}(digitString) || +TYPE_PARSER(construct{}(digitString / spaceCheck) || construct{}(scalar(integer(constant(name))))) // R712 sign -> + | - @@ -730,7 +732,7 @@ constexpr auto sign = "+"_ch >> pure(Sign::Positive) || "-"_ch >> pure(Sign::Negative); // R713 signed-real-literal-constant -> [sign] real-literal-constant -constexpr auto signedRealLiteralConstant = spaces >> +constexpr auto signedRealLiteralConstant = space >> construct{}(maybe(sign), realLiteralConstant); // R714 real-literal-constant -> @@ -740,7 +742,7 @@ constexpr auto signedRealLiteralConstant = spaces >> // R716 exponent-letter -> E | D // Extension: Q // R717 exponent -> signed-digit-string -// N.B. Preceding spaces are not skipped. +// N.B. Preceding space are not skipped. constexpr auto exponentPart = ("ed"_ch || extension("q"_ch)) >> signedDigitString; @@ -753,7 +755,8 @@ TYPE_CONTEXT_PARSER("REAL literal constant"_en_US, "."_ch >> digitString >> maybe(exponentPart) >> ok || digitString >> exponentPart >> ok) >> construct{}), - maybe(underscore >> kindParam))) + maybe(underscore >> kindParam)) / + spaceCheck) // R718 complex-literal-constant -> ( real-part , imag-part ) TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US, @@ -762,7 +765,7 @@ TYPE_CONTEXT_PARSER("COMPLEX literal constant"_en_US, // PGI/Intel extension: signed complex literal constant TYPE_PARSER(construct{}( - spaces >> sign, Parser{})) + space >> sign, Parser{})) // R719 real-part -> // signed-int-literal-constant | signed-real-literal-constant | @@ -798,7 +801,7 @@ TYPE_PARSER(construct{}( // R723 char-length -> ( type-param-value ) | digit-string TYPE_PARSER(construct{}(parenthesized(typeParamValue)) || - construct{}(spaces >> digitString)) + construct{}(space >> digitString / spaceCheck)) // R724 char-literal-constant -> // [kind-param _] ' [rep-char]... ' | @@ -806,7 +809,7 @@ TYPE_PARSER(construct{}(parenthesized(typeParamValue)) || // "rep-char" is any non-control character. Doubled interior quotes are // combined. Backslash escapes can be enabled. // PGI extension: nc'...' is Kanji. -// N.B. charLiteralConstantWithoutKind does not skip preceding spaces. +// N.B. charLiteralConstantWithoutKind does not skip preceding space. // N.B. the parsing of "name" takes care to not consume the '_'. constexpr auto charLiteralConstantWithoutKind = "'"_ch >> CharLiteral<'\''>{} || "\""_ch >> CharLiteral<'"'>{}; @@ -815,7 +818,7 @@ TYPE_CONTEXT_PARSER("CHARACTER literal constant"_en_US, construct{}( kindParam / underscore, charLiteralConstantWithoutKind) || construct{}(construct>{}, - spaces >> charLiteralConstantWithoutKind) || + space >> charLiteralConstantWithoutKind) || construct{}( "NC" >> construct>{}( construct{}(construct{})), @@ -1466,9 +1469,9 @@ TYPE_PARSER(construct{}(declarationTypeSpec, parenthesized(nonemptyList(Parser{})))) // R865 letter-spec -> letter [- letter] -TYPE_PARSER(spaces >> (construct{}(letter, maybe("-" >> letter)) || - construct{}(otherIdChar, - construct>{}))) +TYPE_PARSER(space >> (construct{}(letter, maybe("-" >> letter)) || + construct{}(otherIdChar, + construct>{}))) // R867 import-stmt -> // IMPORT [[::] import-name-list] | @@ -1626,7 +1629,7 @@ TYPE_PARSER(construct{}( // R1414 local-defined-operator -> defined-unary-op | defined-binary-op // R1415 use-defined-operator -> defined-unary-op | defined-binary-op // N.B. The name of the operator is captured without the periods around it. -TYPE_PARSER(spaces >> "."_ch >> +TYPE_PARSER(space >> "."_ch >> construct{}(sourced(some(letter) >> construct{})) / "."_ch) @@ -2166,12 +2169,12 @@ TYPE_PARSER(construct{}(statement(assignmentStmt)) || // R1047 masked-elsewhere-stmt -> // ELSEWHERE ( mask-expr ) [where-construct-name] TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_en_US, - "ELSEWHERE" >> construct{}( - parenthesized(logicalExpr), maybe(name))) + "ELSE WHERE" >> construct{}( + parenthesized(logicalExpr), maybe(name))) // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name] TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US, - "ELSEWHERE" >> construct{}(maybe(name))) + "ELSE WHERE" >> construct{}(maybe(name))) // R1049 end-where-stmt -> ENDWHERE [where-construct-name] TYPE_CONTEXT_PARSER("END WHERE statement"_en_US, @@ -2271,7 +2274,7 @@ TYPE_CONTEXT_PARSER("CHANGE TEAM construct"_en_US, // ( team-variable [, coarray-association-list] [, sync-stat-list] ) TYPE_CONTEXT_PARSER("CHANGE TEAM statement"_en_US, construct{}(maybe(name / ":"), - "CHANGE TEAM (" >> teamVariable, + "CHANGE~TEAM (" >> teamVariable, defaulted("," >> nonemptyList(Parser{})), defaulted("," >> nonemptyList(statOrErrmsg))) / ")") @@ -2282,7 +2285,7 @@ TYPE_PARSER(construct{}( // R1114 end-change-team-stmt -> // END TEAM [( [sync-stat-list] )] [team-construct-name] -TYPE_CONTEXT_PARSER("END CHANGE TEAM statement"_en_US, +TYPE_CONTEXT_PARSER("END TEAM statement"_en_US, "END TEAM" >> construct{}( defaulted(parenthesized(optionalList(statOrErrmsg))), maybe(name))) @@ -2348,7 +2351,7 @@ TYPE_PARSER(construct{}(name / "=", scalarIntExpr / ":", TYPE_PARSER( "LOCAL" >> construct{}(construct{}( parenthesized(nonemptyList(name)))) || - "LOCAL INIT" >> + "LOCAL~INIT" >> construct{}(construct{}( parenthesized(nonemptyList(name)))) || "SHARED" >> construct{}(construct{}( @@ -2470,7 +2473,7 @@ TYPE_CONTEXT_PARSER("SELECT RANK construct"_en_US, // ( [associate-name =>] selector ) TYPE_CONTEXT_PARSER("SELECT RANK statement"_en_US, construct{}(maybe(name / ":"), - "SELECT RANK (" >> maybe(name / "=>"), selector / ")")) + "SELECT~RANK (" >> maybe(name / "=>"), selector / ")")) // R1150 select-rank-case-stmt -> // RANK ( scalar-int-constant-expr ) [select-construct-name] | @@ -2504,9 +2507,9 @@ TYPE_CONTEXT_PARSER("SELECT TYPE statement"_en_US, // CLASS IS ( derived-type-spec ) [select-construct-name] | // CLASS DEFAULT [select-construct-name] TYPE_CONTEXT_PARSER("type guard statement"_en_US, - construct{}("TYPE IS" >> + construct{}("TYPE~IS" >> parenthesized(construct{}(typeSpec)) || - "CLASS IS" >> parenthesized(construct{}( + "CLASS~IS" >> parenthesized(construct{}( derivedTypeSpec)) || "CLASS" >> construct{}(defaultKeyword), maybe(name))) @@ -2529,7 +2532,7 @@ TYPE_CONTEXT_PARSER("computed GOTO statement"_en_US, // ERROR STOP [stop-code] [, QUIET = scalar-logical-expr] TYPE_CONTEXT_PARSER("STOP statement"_en_US, construct{}("STOP" >> pure(StopStmt::Kind::Stop) || - "ERROR STOP" >> pure(StopStmt::Kind::ErrorStop), + "ERROR~STOP" >> pure(StopStmt::Kind::ErrorStop), maybe(Parser{}), maybe(", QUIET =" >> scalarLogicalExpr))) // R1162 stop-code -> scalar-default-char-expr | scalar-int-expr @@ -2538,37 +2541,37 @@ TYPE_PARSER(construct{}(scalarDefaultCharExpr) || // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )] TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US, - "SYNC ALL" >> construct{}( + "SYNC~ALL" >> construct{}( defaulted(parenthesized(optionalList(statOrErrmsg))))) // R1166 sync-images-stmt -> SYNC IMAGES ( image-set [, sync-stat-list] ) // R1167 image-set -> int-expr | * TYPE_CONTEXT_PARSER("SYNC IMAGES statement"_en_US, - "SYNC IMAGES" >> parenthesized(construct{}( + "SYNC~IMAGES" >> parenthesized(construct{}( construct{}(intExpr) || construct{}(star), defaulted("," >> nonemptyList(statOrErrmsg))))) // R1168 sync-memory-stmt -> SYNC MEMORY [( [sync-stat-list] )] TYPE_CONTEXT_PARSER("SYNC MEMORY statement"_en_US, - "SYNC MEMORY" >> construct{}( + "SYNC~MEMORY" >> construct{}( defaulted(parenthesized(optionalList(statOrErrmsg))))) // R1169 sync-team-stmt -> SYNC TEAM ( team-variable [, sync-stat-list] ) TYPE_CONTEXT_PARSER("SYNC TEAM statement"_en_US, - "SYNC TEAM" >> parenthesized(construct{}(teamVariable, + "SYNC~TEAM" >> parenthesized(construct{}(teamVariable, defaulted("," >> nonemptyList(statOrErrmsg))))) // R1170 event-post-stmt -> EVENT POST ( event-variable [, sync-stat-list] ) // R1171 event-variable -> scalar-variable TYPE_CONTEXT_PARSER("EVENT POST statement"_en_US, - "EVENT POST" >> parenthesized(construct{}(scalar(variable), + "EVENT~POST" >> parenthesized(construct{}(scalar(variable), defaulted("," >> nonemptyList(statOrErrmsg))))) // R1172 event-wait-stmt -> // EVENT WAIT ( event-variable [, event-wait-spec-list] ) TYPE_CONTEXT_PARSER("EVENT WAIT statement"_en_US, - "EVENT WAIT" >> + "EVENT~WAIT" >> parenthesized(construct{}(scalar(variable), defaulted( "," >> nonemptyList(Parser{}))))) @@ -2584,7 +2587,7 @@ TYPE_PARSER(construct{}(untilSpec) || // FORM TEAM ( team-number , team-variable [, form-team-spec-list] ) // R1176 team-number -> scalar-int-expr TYPE_CONTEXT_PARSER("FORM TEAM statement"_en_US, - "FORM TEAM" >> + "FORM~TEAM" >> parenthesized(construct{}(scalarIntExpr, "," >> teamVariable, defaulted( @@ -3069,7 +3072,7 @@ TYPE_CONTEXT_PARSER("FORMAT statement"_en_US, // R1321 char-string-edit-desc // N.B. C1313 disallows any kind parameter on the character literal. -constexpr auto charStringEditDesc = spaces >> +constexpr auto charStringEditDesc = space >> (charLiteralConstantWithoutKind || rawHollerithLiteral); // R1303 format-items -> format-item [[,] format-item]... @@ -3081,7 +3084,7 @@ static inline int castU64ToInt(std::uint64_t &&n) { return n; // TODO: check for overflow } -constexpr auto repeat = spaces >> applyFunction(castU64ToInt, digitString); +constexpr auto repeat = space >> applyFunction(castU64ToInt, digitString); // R1304 format-item -> // [r] data-edit-desc | control-edit-desc | char-string-edit-desc | @@ -3165,14 +3168,14 @@ TYPE_PARSER(construct{}( // R1312 v -> [sign] digit-string TYPE_PARSER("DT" >> construct{}( - spaces >> defaulted(charLiteralConstantWithoutKind), - defaulted(parenthesized(nonemptyList(spaces >> signedDigitString))))) + space >> defaulted(charLiteralConstantWithoutKind), + defaulted(parenthesized(nonemptyList(space >> signedDigitString))))) // R1314 k -> [sign] digit-string static inline int castS64ToInt(std::int64_t &&n) { return n; // TODO: check for overflow } -constexpr auto scaleFactor = spaces >> +constexpr auto scaleFactor = space >> applyFunction(castS64ToInt, signedDigitString); // R1313 control-edit-desc -> @@ -3241,8 +3244,9 @@ TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US, "PROGRAM" >> name / maybe(extension(parenthesized(ok))))) // R1403 end-program-stmt -> END [PROGRAM [program-name]] +constexpr auto bareEnd = "END" >> defaulted(cut >> maybe(name)); TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US, - construct{}("END" >> defaulted("PROGRAM" >> maybe(name)))) + construct{}("END PROGRAM" >> maybe(name) || bareEnd)) // R1404 module -> // module-stmt [specification-part] [module-subprogram-part] @@ -3258,7 +3262,7 @@ TYPE_CONTEXT_PARSER( // R1406 end-module-stmt -> END [MODULE [module-name]] TYPE_CONTEXT_PARSER("END MODULE statement"_en_US, - "END" >> construct{}(defaulted("MODULE" >> maybe(name)))) + construct{}("END MODULE" >> maybe(name) || bareEnd)) // R1407 module-subprogram-part -> contains-stmt [module-subprogram]... TYPE_CONTEXT_PARSER("module subprogram part"_en_US, @@ -3318,8 +3322,7 @@ TYPE_PARSER(construct{}(name, maybe(":" >> name))) // R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]] TYPE_CONTEXT_PARSER("END SUBMODULE statement"_en_US, - "END" >> - construct{}(defaulted("SUBMODULE" >> maybe(name)))) + construct{}("END SUBMODULE" >> maybe(name) || bareEnd)) // R1420 block-data -> block-data-stmt [specification-part] end-block-data-stmt TYPE_CONTEXT_PARSER("BLOCK DATA subprogram"_en_US, @@ -3332,8 +3335,7 @@ TYPE_CONTEXT_PARSER("BLOCK DATA statement"_en_US, // R1422 end-block-data-stmt -> END [BLOCK DATA [block-data-name]] TYPE_CONTEXT_PARSER("END BLOCK DATA statement"_en_US, - "END" >> - construct{}(defaulted("BLOCK DATA" >> maybe(name)))) + construct{}("END BLOCK DATA" >> maybe(name) || bareEnd)) // R1501 interface-block -> // interface-stmt [interface-specification]... end-interface-stmt @@ -3347,7 +3349,7 @@ TYPE_PARSER(construct{}(Parser{}) || // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE TYPE_PARSER("INTERFACE" >> construct{}(maybe(genericSpec)) || - "ABSTRACT INTERFACE" >> construct{}(construct{})) + "ABSTRACT~INTERFACE" >> construct{}(construct{})) // R1504 end-interface-stmt -> END INTERFACE [generic-spec] TYPE_PARSER( @@ -3368,7 +3370,7 @@ TYPE_CONTEXT_PARSER("interface body"_en_US, constexpr auto specificProcedure = name; // R1506 procedure-stmt -> [MODULE] PROCEDURE [::] specific-procedure-list -TYPE_PARSER(construct{}("MODULE PROCEDURE" >> +TYPE_PARSER(construct{}("MODULE~PROCEDURE" >> pure(ProcedureStmt::Kind::ModuleProcedure), maybe("::"_tok) >> nonemptyList(specificProcedure)) || construct{}( @@ -3575,7 +3577,7 @@ TYPE_PARSER(construct{}( // R1533 end-function-stmt -> END [FUNCTION [function-name]] TYPE_PARSER( - "END" >> construct{}(defaulted("FUNCTION" >> maybe(name)))) + construct{}("END FUNCTION" >> maybe(name) || bareEnd)) // R1534 subroutine-subprogram -> // subroutine-stmt [specification-part] [execution-part] @@ -3599,8 +3601,8 @@ TYPE_PARSER( TYPE_PARSER(construct{}(name) || construct{}(star)) // R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]] -TYPE_PARSER("END" >> - construct{}(defaulted("SUBROUTINE" >> maybe(name)))) +TYPE_PARSER( + construct{}("END SUBROUTINE" >> maybe(name) || bareEnd)) // R1538 separate-module-subprogram -> // mp-subprogram-stmt [specification-part] [execution-part] @@ -3612,12 +3614,11 @@ TYPE_CONTEXT_PARSER("separate module subprogram"_en_US, // R1539 mp-subprogram-stmt -> MODULE PROCEDURE procedure-name TYPE_CONTEXT_PARSER("MODULE PROCEDURE statement"_en_US, - construct{}("MODULE PROCEDURE" >> name)) + construct{}("MODULE~PROCEDURE" >> name)) // R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]] TYPE_CONTEXT_PARSER("END PROCEDURE statement"_en_US, - "END" >> - construct{}(defaulted("PROCEDURE" >> maybe(name)))) + construct{}("END PROCEDURE" >> maybe(name) || bareEnd)) // R1541 entry-stmt -> ENTRY entry-name [( [dummy-arg-list] ) [suffix]] TYPE_PARSER("ENTRY" >> @@ -3641,8 +3642,8 @@ TYPE_PARSER(construct{}( // Directives, extensions, and deprecated statements // !DIR$ IVDEP // !DIR$ IGNORE_TKR [ [(tkr...)] name ]... -constexpr auto beginDirective = skipEmptyLines >> spaces >> "!"_ch; -constexpr auto endDirective = spaces >> endOfLine; +constexpr auto beginDirective = skipEmptyLines >> space >> "!"_ch; +constexpr auto endDirective = space >> endOfLine; constexpr auto ivdep = "DIR$ IVDEP" >> construct{}; constexpr auto ignore_tkr = "DIR$ IGNORE_TKR" >> optionalList(construct{}( diff --git a/flang/lib/parser/message.h b/flang/lib/parser/message.h index d55e7d5396a4..b140dba93e66 100644 --- a/flang/lib/parser/message.h +++ b/flang/lib/parser/message.h @@ -140,6 +140,7 @@ public: std::swap(last_, that.last_); } + bool empty() const { return messages_.empty(); } iterator begin() { return messages_.begin(); } iterator end() { return messages_.end(); } const_iterator begin() const { return messages_.cbegin(); } diff --git a/flang/lib/parser/parsing.cc b/flang/lib/parser/parsing.cc index b1a2f434f792..78e3ede525df 100644 --- a/flang/lib/parser/parsing.cc +++ b/flang/lib/parser/parsing.cc @@ -86,10 +86,6 @@ bool Parsing::Parse() { .set_userState(&userState); parseTree_ = program.Parse(&parseState); anyFatalError_ = parseState.anyErrorRecovery(); -#if 0 // pgf90 -Mstandard enables warnings only, they aren't fatal. - // TODO: -Werror - || (options_.isStrictlyStandard && parseState.anyConformanceViolation()); -#endif consumedWholeFile_ = parseState.IsAtEnd(); finalRestingPlace_ = parseState.GetLocation(); messages_.Annex(parseState.messages()); diff --git a/flang/lib/parser/token-parsers.h b/flang/lib/parser/token-parsers.h index 2e3e1541baad..14fa2ad4a597 100644 --- a/flang/lib/parser/token-parsers.h +++ b/flang/lib/parser/token-parsers.h @@ -47,7 +47,7 @@ constexpr auto digit = CharPredicateGuard{IsDecimalDigit, "expected digit"_en_US}; // "x"_ch matches one instance of the character 'x' without skipping any -// spaces before or after. The parser returns the location of the character +// space before or after. The parser returns the location of the character // on success. class AnyOfChar { public: @@ -79,10 +79,10 @@ constexpr AnyOfChar operator""_ch(const char str[], std::size_t n) { return AnyOfChar{str, n}; } -// Skips over spaces. Always succeeds. -constexpr struct Spaces { +// Skips over optional spaces. Always succeeds. +constexpr struct Space { using resultType = Success; - constexpr Spaces() {} + constexpr Space() {} static std::optional Parse(ParseState *state) { while (std::optional ch{state->PeekAtNextChar()}) { if (*ch != ' ') { @@ -92,25 +92,45 @@ constexpr struct Spaces { } return {Success{}}; } -} spaces; +} space; + +// Skips a space that in free from requires a warning if it precedes a +// character that could begin an identifier or keyword. Always succeeds. +static inline void MissingSpace(ParseState *state) { + if (!state->inFixedForm()) { + state->set_anyConformanceViolation(); + if (state->warnOnNonstandardUsage()) { + state->PutMessage("expected space"_en_US); + } + } +} -// Warn about a missing space that must be present in free form. -// Always succeeds. constexpr struct SpaceCheck { using resultType = Success; constexpr SpaceCheck() {} static std::optional Parse(ParseState *state) { - if (!state->inFixedForm()) { - if (std::optional ch{state->PeekAtNextChar()}) { - if (IsLegalInIdentifier(*ch)) { - state->PutMessage("expected space"_en_US); - } + if (std::optional ch{state->PeekAtNextChar()}) { + if (*ch == ' ') { + state->UncheckedAdvance(); + return space.Parse(state); + } + if (IsLegalInIdentifier(*ch)) { + MissingSpace(state); } } return {Success{}}; } } spaceCheck; +// Matches a token string. Spaces in the token string denote where +// an optional space may appear in the source; the character '~' in +// a token string denotes a space that, if missing in free form, +// elicits a warning. Spaces before and after the token are also +// skipped. +// +// Token strings appear in the grammar as C++ user-defined literals +// like "BIND ( C )"_tok. The _tok suffix is not required before +// the sequencing operator >> or after the sequencing operator /. class TokenStringMatch { public: using resultType = Success; @@ -119,14 +139,14 @@ public: : str_{str}, bytes_{n} {} constexpr TokenStringMatch(const char *str) : str_{str} {} std::optional Parse(ParseState *state) const { - spaces.Parse(state); + space.Parse(state); const char *start{state->GetLocation()}; const char *p{str_}; std::optional at; // initially empty for (std::size_t j{0}; j < bytes_ && *p != '\0'; ++j, ++p) { - const auto spaceSkipping{*p == ' '}; + const auto spaceSkipping{*p == ' ' || *p == '~'}; if (spaceSkipping) { - if (j + 1 == bytes_ || p[1] == ' ' || p[1] == '\0') { + if (j + 1 == bytes_ || p[1] == ' ' || p[1] == '~' || p[1] == '\0') { continue; // redundant; ignore } } @@ -137,13 +157,14 @@ public: } } if (spaceSkipping) { - // medial space: space accepted, none required - // TODO: designate and enforce free-form mandatory white space if (**at == ' ') { at = nextCh.Parse(state); if (!at.has_value()) { return {}; } + } else if (*p == '~') { + // This space is notionally required in free form. + MissingSpace(state); } // 'at' remains full for next iteration } else if (**at == ToLowerCaseLetter(*p)) { @@ -153,7 +174,10 @@ public: return {}; } } - return spaces.Parse(state); + if (IsLegalInIdentifier(p[-1])) { + return spaceCheck.Parse(state); + } + return space.Parse(state); } private: @@ -304,7 +328,7 @@ struct BOZLiteral { } }; - spaces.Parse(state); + space.Parse(state); const char *start{state->GetLocation()}; std::optional at{nextCh.Parse(state)}; if (!at.has_value()) { @@ -349,6 +373,7 @@ struct BOZLiteral { !baseChar(**at)) { return {}; } + spaceCheck.Parse(state); } if (content.empty()) { @@ -408,7 +433,7 @@ struct DigitString { struct HollerithLiteral { using resultType = std::string; static std::optional Parse(ParseState *state) { - spaces.Parse(state); + space.Parse(state); const char *start{state->GetLocation()}; std::optional charCount{DigitString{}.Parse(state)}; if (!charCount || *charCount < 1) { diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index 95eba6ca53f7..4b73d18a5f1f 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -62,6 +62,7 @@ struct DriverOptions { bool compileOnly{false}; // -c std::string outputPath; // -o path bool forcedForm{false}; // -Mfixed or -Mfree appeared + bool warningsAreErrors{false}; // -Werror Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF8}; bool parseOnly{false}; bool dumpProvenance{false}; @@ -171,6 +172,10 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options, } parsing.messages().Emit(std::cerr, driver.prefix); + if (driver.warningsAreErrors && + !parsing.messages().empty()) { + exit(EXIT_FAILURE); + } if (driver.parseOnly) { return {}; } @@ -292,6 +297,8 @@ int main(int argc, char *const argv[]) { options.enableBackslashEscapes = true; } else if (arg == "-Mstandard") { options.isStrictlyStandard = true; + } else if (arg == "-Werror") { + driver.warningsAreErrors = true; } else if (arg == "-ed") { options.enableOldDebugLines = true; } else if (arg == "-E") { @@ -326,6 +333,7 @@ int main(int argc, char *const argv[]) { << " -M[no]backslash disable[enable] \\escapes in literals\n" << " -Mstandard enable conformance warnings\n" << " -Mx,125,4 set bit 2 in xflag[125] (all Kanji mode)\n" + << " -Werror treat warnings as errors\n" << " -ed enable fixed form D lines\n" << " -E prescan & preprocess only\n" << " -fparse-only parse only, no output except messages\n"