replica
/
hanchenye-llvm-project
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[flang] Emit warnings in free form when a required space is missing. 

Original-commit: flang-compiler/f18@e41917d144
Reviewed-on: https://github.com/flang-compiler/f18/pull/35
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2018-03-29 16:06:31 -07:00
parent 9e6c284b2d
commit 1f3c41b521
5 changed files with 118 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
flang/lib/parser/grammar.h
View File

@ -157,7 +157,7 @@ template<typename PA> 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<P> 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<typename PA>
using statementConstructor = construct<Statement<typename PA::resultType>>;
template<typename PA> inline constexpr auto unterminatedStatement(const PA &p) {
return skipEmptyLines >>
sourced(statementConstructor<PA>{}(maybe(label), spaces >> p));
sourced(statementConstructor<PA>{}(maybe(label), space >> p));
}
constexpr auto endOfLine = "\n"_ch / skipEmptyLines ||
fail<const char *>("expected end of line"_en_US);
constexpr auto endOfStmt = spaces >>
constexpr auto endOfStmt = space >>
(";"_ch / skipMany(";"_tok) / maybe(endOfLine) || endOfLine);
template<typename PA> inline constexpr auto statement(const PA &p) {
@ -186,7 +186,7 @@ template<typename PA> 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<ActionStmt>{}(
construct<ActionStmt>{}(indirect(Parser<EventPostStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<EventWaitStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<ExitStmt>{})) ||
"FAIL IMAGE" >> construct<ActionStmt>{}(construct<FailImageStmt>{}) ||
"FAIL~IMAGE" >> construct<ActionStmt>{}(construct<FailImageStmt>{}) ||
construct<ActionStmt>{}(indirect(Parser<FlushStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<FormTeamStmt>{})) ||
construct<ActionStmt>{}(indirect(Parser<GotoStmt>{})) ||
@ -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<Name>{}))
TYPE_PARSER(space >> sourced(attempt(rawName) >> construct<Name>{}))
constexpr auto keyword = construct<Keyword>{}(name);
// R605 literal-constant ->
@ -603,7 +603,7 @@ constexpr auto keyword = construct<Keyword>{}(name);
// complex-literal-constant | logical-literal-constant |
// char-literal-constant | boz-literal-constant
TYPE_PARSER(construct<LiteralConstant>{}(Parser<HollerithLiteralConstant>{}) ||
construct<LiteralConstant>{}(spaces >> realLiteralConstant) ||
construct<LiteralConstant>{}(space >> realLiteralConstant) ||
construct<LiteralConstant>{}(intLiteralConstant) ||
construct<LiteralConstant>{}(Parser<ComplexLiteralConstant>{}) ||
construct<LiteralConstant>{}(Parser<BOZLiteralConstant>{}) ||
@ -696,10 +696,10 @@ TYPE_PARSER(construct<IntegerTypeSpec>{}("INTEGER" >> maybe(kindSelector)))
TYPE_PARSER(construct<KindSelector>{}(
parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
extension(construct<KindSelector>{}(
construct<KindSelector::StarSize>{}("*" >> digitString))))
construct<KindSelector::StarSize>{}("*" >> 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<SignedIntLiteralConstant>{}(
signedDigitString, maybe(underscore >> kindParam))))
TYPE_PARSER(space >> sourced(construct<SignedIntLiteralConstant>{}(
signedDigitString, maybe(underscore >> kindParam))) /
spaceCheck)
// R708 int-literal-constant -> digit-string [_ kind-param]
TYPE_PARSER(construct<IntLiteralConstant>{}(
spaces >> digitString, maybe(underscore >> kindParam)))
space >> digitString, maybe(underscore >> kindParam)) /
spaceCheck)
// R709 kind-param -> digit-string | scalar-int-constant-name
TYPE_PARSER(construct<KindParam>{}(digitString) ||
TYPE_PARSER(construct<KindParam>{}(digitString / spaceCheck) ||
construct<KindParam>{}(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<SignedRealLiteralConstant>{}(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<RealLiteralConstant::Real>{}),
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<SignedComplexLiteralConstant>{}(
spaces >> sign, Parser<ComplexLiteralConstant>{}))
space >> sign, Parser<ComplexLiteralConstant>{}))
// R719 real-part ->
// signed-int-literal-constant | signed-real-literal-constant |
@ -798,7 +801,7 @@ TYPE_PARSER(construct<LengthSelector>{}(
// R723 char-length -> ( type-param-value ) | digit-string
TYPE_PARSER(construct<CharLength>{}(parenthesized(typeParamValue)) ||
construct<CharLength>{}(spaces >> digitString))
construct<CharLength>{}(space >> digitString / spaceCheck))
// R724 char-literal-constant ->
// [kind-param _] ' [rep-char]... ' |
@ -806,7 +809,7 @@ TYPE_PARSER(construct<CharLength>{}(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<CharLiteralConstant>{}(
kindParam / underscore, charLiteralConstantWithoutKind) ||
construct<CharLiteralConstant>{}(construct<std::optional<KindParam>>{},
spaces >> charLiteralConstantWithoutKind) ||
space >> charLiteralConstantWithoutKind) ||
construct<CharLiteralConstant>{}(
"NC" >> construct<std::optional<KindParam>>{}(
construct<KindParam>{}(construct<KindParam::Kanji>{})),
@ -1466,9 +1469,9 @@ TYPE_PARSER(construct<ImplicitSpec>{}(declarationTypeSpec,
parenthesized(nonemptyList(Parser<LetterSpec>{}))))
// R865 letter-spec -> letter [- letter]
TYPE_PARSER(spaces >> (construct<LetterSpec>{}(letter, maybe("-" >> letter)) ||
construct<LetterSpec>{}(otherIdChar,
construct<std::optional<const char *>>{})))
TYPE_PARSER(space >> (construct<LetterSpec>{}(letter, maybe("-" >> letter)) ||
construct<LetterSpec>{}(otherIdChar,
construct<std::optional<const char *>>{})))
// R867 import-stmt ->
// IMPORT [[::] import-name-list] |
@ -1626,7 +1629,7 @@ TYPE_PARSER(construct<SubstringRange>{}(
// 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<DefinedOpName>{}(sourced(some(letter) >> construct<Name>{})) /
"."_ch)
@ -2166,12 +2169,12 @@ TYPE_PARSER(construct<WhereBodyConstruct>{}(statement(assignmentStmt)) ||
// R1047 masked-elsewhere-stmt ->
// ELSEWHERE ( mask-expr ) [where-construct-name]
TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_en_US,
"ELSEWHERE" >> construct<MaskedElsewhereStmt>{}(
parenthesized(logicalExpr), maybe(name)))
"ELSE WHERE" >> construct<MaskedElsewhereStmt>{}(
parenthesized(logicalExpr), maybe(name)))
// R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US,
"ELSEWHERE" >> construct<ElsewhereStmt>{}(maybe(name)))
"ELSE WHERE" >> construct<ElsewhereStmt>{}(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<ChangeTeamStmt>{}(maybe(name / ":"),
"CHANGE TEAM (" >> teamVariable,
"CHANGE~TEAM (" >> teamVariable,
defaulted("," >> nonemptyList(Parser<CoarrayAssociation>{})),
defaulted("," >> nonemptyList(statOrErrmsg))) /
")")
@ -2282,7 +2285,7 @@ TYPE_PARSER(construct<CoarrayAssociation>{}(
// 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<EndChangeTeamStmt>{}(
defaulted(parenthesized(optionalList(statOrErrmsg))), maybe(name)))
@ -2348,7 +2351,7 @@ TYPE_PARSER(construct<ConcurrentControl>{}(name / "=", scalarIntExpr / ":",
TYPE_PARSER(
"LOCAL" >> construct<LocalitySpec>{}(construct<LocalitySpec::Local>{}(
parenthesized(nonemptyList(name)))) ||
"LOCAL INIT" >>
"LOCAL~INIT" >>
construct<LocalitySpec>{}(construct<LocalitySpec::LocalInit>{}(
parenthesized(nonemptyList(name)))) ||
"SHARED" >> construct<LocalitySpec>{}(construct<LocalitySpec::Shared>{}(
@ -2470,7 +2473,7 @@ TYPE_CONTEXT_PARSER("SELECT RANK construct"_en_US,
// ( [associate-name =>] selector )
TYPE_CONTEXT_PARSER("SELECT RANK statement"_en_US,
construct<SelectRankStmt>{}(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<TypeGuardStmt>{}("TYPE IS" >>
construct<TypeGuardStmt>{}("TYPE~IS" >>
parenthesized(construct<TypeGuardStmt::Guard>{}(typeSpec)) ||
"CLASS IS" >> parenthesized(construct<TypeGuardStmt::Guard>{}(
"CLASS~IS" >> parenthesized(construct<TypeGuardStmt::Guard>{}(
derivedTypeSpec)) ||
"CLASS" >> construct<TypeGuardStmt::Guard>{}(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<StopStmt>{}("STOP" >> pure(StopStmt::Kind::Stop) ||
"ERROR STOP" >> pure(StopStmt::Kind::ErrorStop),
"ERROR~STOP" >> pure(StopStmt::Kind::ErrorStop),
maybe(Parser<StopCode>{}), maybe(", QUIET =" >> scalarLogicalExpr)))
// R1162 stop-code -> scalar-default-char-expr | scalar-int-expr
@ -2538,37 +2541,37 @@ TYPE_PARSER(construct<StopCode>{}(scalarDefaultCharExpr) ||
// R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US,
"SYNC ALL" >> construct<SyncAllStmt>{}(
"SYNC~ALL" >> construct<SyncAllStmt>{}(
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<SyncImagesStmt>{}(
"SYNC~IMAGES" >> parenthesized(construct<SyncImagesStmt>{}(
construct<SyncImagesStmt::ImageSet>{}(intExpr) ||
construct<SyncImagesStmt::ImageSet>{}(star),
defaulted("," >> nonemptyList(statOrErrmsg)))))
// R1168 sync-memory-stmt -> SYNC MEMORY [( [sync-stat-list] )]
TYPE_CONTEXT_PARSER("SYNC MEMORY statement"_en_US,
"SYNC MEMORY" >> construct<SyncMemoryStmt>{}(
"SYNC~MEMORY" >> construct<SyncMemoryStmt>{}(
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<SyncTeamStmt>{}(teamVariable,
"SYNC~TEAM" >> parenthesized(construct<SyncTeamStmt>{}(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<EventPostStmt>{}(scalar(variable),
"EVENT~POST" >> parenthesized(construct<EventPostStmt>{}(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<EventWaitStmt>{}(scalar(variable),
defaulted(
"," >> nonemptyList(Parser<EventWaitStmt::EventWaitSpec>{})))))
@ -2584,7 +2587,7 @@ TYPE_PARSER(construct<EventWaitStmt::EventWaitSpec>{}(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<FormTeamStmt>{}(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<format::IntrinsicTypeDataEditDesc>{}(
// R1312 v -> [sign] digit-string
TYPE_PARSER("DT" >>
construct<format::DerivedTypeDataEditDesc>{}(
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<EndProgramStmt>{}("END" >> defaulted("PROGRAM" >> maybe(name))))
construct<EndProgramStmt>{}("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<EndModuleStmt>{}(defaulted("MODULE" >> maybe(name))))
construct<EndModuleStmt>{}("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<ParentIdentifier>{}(name, maybe(":" >> name)))
// R1419 end-submodule-stmt -> END [SUBMODULE [submodule-name]]
TYPE_CONTEXT_PARSER("END SUBMODULE statement"_en_US,
"END" >>
construct<EndSubmoduleStmt>{}(defaulted("SUBMODULE" >> maybe(name))))
construct<EndSubmoduleStmt>{}("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<EndBlockDataStmt>{}(defaulted("BLOCK DATA" >> maybe(name))))
construct<EndBlockDataStmt>{}("END BLOCK DATA" >> maybe(name) || bareEnd))
// R1501 interface-block ->
// interface-stmt [interface-specification]... end-interface-stmt
@ -3347,7 +3349,7 @@ TYPE_PARSER(construct<InterfaceSpecification>{}(Parser<InterfaceBody>{}) ||
// R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE
TYPE_PARSER("INTERFACE" >> construct<InterfaceStmt>{}(maybe(genericSpec)) ||
"ABSTRACT INTERFACE" >> construct<InterfaceStmt>{}(construct<Abstract>{}))
"ABSTRACT~INTERFACE" >> construct<InterfaceStmt>{}(construct<Abstract>{}))
// 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<ProcedureStmt>{}("MODULE PROCEDURE" >>
TYPE_PARSER(construct<ProcedureStmt>{}("MODULE~PROCEDURE" >>
pure(ProcedureStmt::Kind::ModuleProcedure),
maybe("::"_tok) >> nonemptyList(specificProcedure)) ||
construct<ProcedureStmt>{}(
@ -3575,7 +3577,7 @@ TYPE_PARSER(construct<Suffix>{}(
// R1533 end-function-stmt -> END [FUNCTION [function-name]]
TYPE_PARSER(
"END" >> construct<EndFunctionStmt>{}(defaulted("FUNCTION" >> maybe(name))))
construct<EndFunctionStmt>{}("END FUNCTION" >> maybe(name) || bareEnd))
// R1534 subroutine-subprogram ->
// subroutine-stmt [specification-part] [execution-part]
@ -3599,8 +3601,8 @@ TYPE_PARSER(
TYPE_PARSER(construct<DummyArg>{}(name) || construct<DummyArg>{}(star))
// R1537 end-subroutine-stmt -> END [SUBROUTINE [subroutine-name]]
TYPE_PARSER("END" >>
construct<EndSubroutineStmt>{}(defaulted("SUBROUTINE" >> maybe(name))))
TYPE_PARSER(
construct<EndSubroutineStmt>{}("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<MpSubprogramStmt>{}("MODULE PROCEDURE" >> name))
construct<MpSubprogramStmt>{}("MODULE~PROCEDURE" >> name))
// R1540 end-mp-subprogram-stmt -> END [PROCEDURE [procedure-name]]
TYPE_CONTEXT_PARSER("END PROCEDURE statement"_en_US,
"END" >>
construct<EndMpSubprogramStmt>{}(defaulted("PROCEDURE" >> maybe(name))))
construct<EndMpSubprogramStmt>{}("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<StmtFunctionStmt>{}(
// 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<CompilerDirective::IVDEP>{};
constexpr auto ignore_tkr = "DIR$ IGNORE_TKR" >>
optionalList(construct<CompilerDirective::IgnoreTKR>{}(

1
flang/lib/parser/message.h
View File

@ -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(); }

4
flang/lib/parser/parsing.cc
View File

@ -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());

65
flang/lib/parser/token-parsers.h
View File

@ -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<Success> Parse(ParseState *state) {
while (std::optional<char> 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<Success> Parse(ParseState *state) {
if (!state->inFixedForm()) {
if (std::optional<char> ch{state->PeekAtNextChar()}) {
if (IsLegalInIdentifier(*ch)) {
state->PutMessage("expected space"_en_US);
}
if (std::optional<char> 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<Success> Parse(ParseState *state) const {
spaces.Parse(state);
space.Parse(state);
const char *start{state->GetLocation()};
const char *p{str_};
std::optional<const char *> 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<const char *> 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<std::string> Parse(ParseState *state) {
spaces.Parse(state);
space.Parse(state);
const char *start{state->GetLocation()};
std::optional<std::uint64_t> charCount{DigitString{}.Parse(state)};
if (!charCount || *charCount < 1) {

8
flang/tools/f18/f18.cc
View File

@ -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"