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

Original-commit: flang-compiler/f18@e41917d144354271c5f58cbd6033ef704d0e08c7
Reviewed-on: https://github.com/flang-compiler/f18/pull/35
Tree-same-pre-rewrite: false

diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h
index 5e194d0..aedf3dd 100644 (file)
--- a/flang/lib/parser/grammar.h
+++ b/flang/lib/parser/grammar.h
@@ -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>{}(

diff --git a/flang/lib/parser/message.h b/flang/lib/parser/message.h
index d55e7d5..b140dba 100644 (file)
--- 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 b1a2f43..78e3ede 100644 (file)
--- 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 2e3e154..14fa2ad 100644 (file)
--- 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<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) {

diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc
index 95eba6c..4b73d18 100644 (file)
--- 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"