diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -65,13 +65,16 @@ ".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) || ".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) || extension( + "nonstandard usage: .XOR. spelling of .NEQV."_port_en_US, ".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) || extension( + "nonstandard usage: abbreviated logical operator"_port_en_US, ".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) || - ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) || - ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) || - extension( - ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))}; + ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) || + ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) || + extension( + "nonstandard usage: .X. spelling of .NEQV."_port_en_US, + ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))}; constexpr auto intrinsicOperator{ "**" >> pure(DefinedOperator::IntrinsicOperator::Power) || @@ -83,6 +86,7 @@ "-" >> pure(DefinedOperator::IntrinsicOperator::Subtract) || "<=" >> pure(DefinedOperator::IntrinsicOperator::LE) || extension( + "nonstandard usage: <> spelling of /= or .NE."_port_en_US, "<>" >> pure(DefinedOperator::IntrinsicOperator::NE)) || "<" >> pure(DefinedOperator::IntrinsicOperator::LT) || "==" >> pure(DefinedOperator::IntrinsicOperator::EQ) || @@ -178,6 +182,7 @@ construct("*" >> construct())) || extension( + "nonstandard usage: STRUCTURE"_port_en_US, construct( // As is also done for the STRUCTURE statement, the name of // the structure includes the surrounding slashes to avoid @@ -202,9 +207,11 @@ "CHARACTER" >> maybe(Parser{}))), construct(construct( "LOGICAL" >> maybe(kindSelector))), - extension(construct( - "DOUBLE COMPLEX" >> construct())), - extension( + extension( + "nonstandard usage: DOUBLE COMPLEX"_port_en_US, + construct("DOUBLE COMPLEX" >> + construct())), + extension("nonstandard usage: BYTE"_port_en_US, construct(construct( "BYTE" >> construct>(pure(1))))))) @@ -215,8 +222,10 @@ // Legacy extension: kind-selector -> * digit-string TYPE_PARSER(construct( parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) || - extension(construct( - construct("*" >> digitString64 / spaceCheck)))) + extension( + "nonstandard usage: TYPE*KIND syntax"_port_en_US, + construct(construct( + "*" >> digitString64 / spaceCheck)))) // R707 signed-int-literal-constant -> [sign] int-literal-constant TYPE_PARSER(sourced(construct( @@ -251,7 +260,9 @@ // Extension: Q // R717 exponent -> signed-digit-string constexpr auto exponentPart{ - ("ed"_ch || extension("q"_ch)) >> + ("ed"_ch || + extension( + "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >> SignedDigitString{}}; TYPE_CONTEXT_PARSER("REAL literal constant"_en_US, @@ -431,6 +442,7 @@ // The source field of the Name will be replaced with a distinct generated name. TYPE_CONTEXT_PARSER("%FILL item"_en_US, extension( + "nonstandard usage: %FILL"_port_en_US, construct(space >> sourced("%FILL" >> construct()), maybe(Parser{}), maybe("*" >> charLength)))) TYPE_PARSER(construct(Parser{}) || @@ -475,10 +487,12 @@ TYPE_PARSER(construct("=>" >> nullInit) || construct("=>" >> initialDataTarget) || construct("=" >> constantExpr) || - extension(construct( - "/" >> nonemptyList("expected values"_err_en_US, - indirect(Parser{})) / - "/"))) + extension( + "nonstandard usage: /initialization/"_port_en_US, + construct( + "/" >> nonemptyList("expected values"_err_en_US, + indirect(Parser{})) / + "/"))) // R745 private-components-stmt -> PRIVATE // R747 binding-private-stmt -> PRIVATE @@ -608,10 +622,12 @@ nonemptyList("expected entity declarations"_err_en_US, entityDeclWithoutEqInit)) || // PGI-only extension: comma in place of doubled colons - extension(construct( - declarationTypeSpec, defaulted("," >> nonemptyList(Parser{})), - withMessage("expected entity declarations"_err_en_US, - "," >> nonemptyList(entityDecl))))) + extension( + "nonstandard usage: ',' in place of '::'"_port_en_US, + construct(declarationTypeSpec, + defaulted("," >> nonemptyList(Parser{})), + withMessage("expected entity declarations"_err_en_US, + "," >> nonemptyList(entityDecl))))) // R802 attr-spec -> // access-spec | ALLOCATABLE | ASYNCHRONOUS | @@ -841,6 +857,7 @@ construct(signedRealLiteralConstant), construct(signedIntLiteralConstant), extension( + "nonstandard usage: signed COMPLEX literal"_port_en_US, construct(Parser{})), construct(nullInit), construct(indirect(designator) / !"("_tok), @@ -869,8 +886,10 @@ construct( "PARAMETER" >> parenthesized(nonemptyList(Parser{})))) TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US, - extension(construct( - "PARAMETER" >> nonemptyList(Parser{})))) + extension( + "nonstandard usage: PARAMETER without parentheses"_port_en_US, + construct( + "PARAMETER" >> nonemptyList(Parser{})))) // R852 named-constant-def -> named-constant = constant-expr TYPE_PARSER(construct(namedConstant, "=" >> constantExpr)) @@ -1024,6 +1043,7 @@ constexpr auto percentOrDot{"%"_tok || // legacy VAX extension for RECORD field access extension( + "nonstandard usage: component access with '.' in place of '%'"_port_en_US, "."_tok / lookAhead(OldStructureComponentName{}))}; // R902 variable -> designator | function-reference @@ -1184,10 +1204,12 @@ maybe(("="_tok || ":"_tok) >> digitString64))))) / endDirective) -TYPE_PARSER(extension(construct( - "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US, - construct("(" >> objectName / ",", - objectName, maybe(Parser{}) / ")"))))) +TYPE_PARSER(extension( + "nonstandard usage: based POINTER"_port_en_US, + construct( + "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US, + construct("(" >> objectName / ",", + objectName, maybe(Parser{}) / ")"))))) // Subtle: the name includes the surrounding slashes, which avoids // clashes with other uses of the name in the same scope. @@ -1206,10 +1228,12 @@ construct(indirect(nestedStructureDef))) TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US, - extension(construct( - statement(Parser{}), many(Parser{}), - statement( - construct("END STRUCTURE"_tok))))) + extension( + "nonstandard usage: STRUCTURE"_port_en_US, + construct(statement(Parser{}), + many(Parser{}), + statement(construct( + "END STRUCTURE"_tok))))) TYPE_CONTEXT_PARSER("UNION definition"_en_US, construct(statement(construct("UNION"_tok)), diff --git a/flang/lib/Parser/basic-parsers.h b/flang/lib/Parser/basic-parsers.h --- a/flang/lib/Parser/basic-parsers.h +++ b/flang/lib/Parser/basic-parsers.h @@ -845,7 +845,8 @@ public: using resultType = typename PA::resultType; constexpr NonstandardParser(const NonstandardParser &) = default; - constexpr NonstandardParser(PA parser) : parser_{parser} {} + constexpr NonstandardParser(PA parser, MessageFixedText msg) + : parser_{parser}, message_{msg} {} std::optional Parse(ParseState &state) const { if (UserState * ustate{state.userState()}) { if (!ustate->features().IsEnabled(LF)) { @@ -855,19 +856,20 @@ auto at{state.GetLocation()}; auto result{parser_.Parse(state)}; if (result) { - state.Nonstandard(CharBlock{at, std::max(state.GetLocation(), at + 1)}, - LF, "nonstandard usage"_port_en_US); + state.Nonstandard( + CharBlock{at, std::max(state.GetLocation(), at + 1)}, LF, message_); } return result; } private: const PA parser_; + const MessageFixedText message_; }; template -inline constexpr auto extension(PA parser) { - return NonstandardParser(parser); +inline constexpr auto extension(MessageFixedText feature, PA parser) { + return NonstandardParser(parser, feature); } // If a is a parser for some deprecated or deleted language feature LF, diff --git a/flang/lib/Parser/executable-parsers.cpp b/flang/lib/Parser/executable-parsers.cpp --- a/flang/lib/Parser/executable-parsers.cpp +++ b/flang/lib/Parser/executable-parsers.cpp @@ -76,6 +76,7 @@ construct( statement(indirect(dataStmt))), extension( + "nonstandard usage: NAMELIST in execution part"_port_en_US, construct( statement(indirect(Parser{})))), obsoleteExecutionPartConstruct))), diff --git a/flang/lib/Parser/expr-parsers.cpp b/flang/lib/Parser/expr-parsers.cpp --- a/flang/lib/Parser/expr-parsers.cpp +++ b/flang/lib/Parser/expr-parsers.cpp @@ -44,6 +44,7 @@ TYPE_PARSER( // PGI/Intel extension: accept triplets in array constructors extension( + "nonstandard usage: triplet in array constructor"_port_en_US, construct(construct(scalarIntExpr, ":" >> scalarIntExpr, maybe(":" >> scalarIntExpr)))) || construct(indirect(expr)) || @@ -76,10 +77,13 @@ construct(Parser{}), // PGI/XLF extension: COMPLEX constructor (x,y) extension( + "nonstandard usage: generalized COMPLEX constructor"_port_en_US, construct(parenthesized( construct(expr, "," >> expr)))), - extension(construct("%LOC" >> - parenthesized(construct(indirect(variable)))))))}; + extension( + "nonstandard usage: %LOC"_port_en_US, + construct("%LOC" >> parenthesized(construct( + indirect(variable)))))))}; // R1002 level-1-expr -> [defined-unary-op] primary // TODO: Reasonable extension: permit multiple defined-unary-ops @@ -87,8 +91,10 @@ first(primary, // must come before define op to resolve .TRUE._8 ambiguity construct(construct(definedOpName, primary)), extension( + "nonstandard usage: signed primary"_port_en_US, construct(construct("+" >> primary))), extension( + "nonstandard usage: signed primary"_port_en_US, construct(construct("-" >> primary)))))}; // R1004 mult-operand -> level-1-expr [power-op mult-operand] @@ -244,6 +250,7 @@ (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) || (".NE."_tok || "/="_tok || extension( + "nonstandard usage: <> for /= or .NE."_port_en_US, "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >> applyLambda(ne, level3Expr) || (".GE."_tok || ">="_tok) >> applyLambda(ge, level3Expr) || @@ -273,6 +280,7 @@ inline constexpr auto logicalOp(const char *op, const char *abbrev) { return TokenStringMatch{op} || extension( + "nonstandard usage: abbreviated LOGICAL operator"_port_en_US, TokenStringMatch{abbrev}); } @@ -356,6 +364,7 @@ auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) || (".NEQV."_tok || extension( + "nonstandard usage: .XOR./.X. spelling of .NEQV."_port_en_US, logicalOp(".XOR.", ".X."))) >> applyLambda(neqv, equivOperand)))}; while (std::optional next{more.Parse(state)}) { @@ -397,8 +406,10 @@ // and intrinsic operator names; this is handled by attempting their parses // first, and by name resolution on their definitions, for best errors. // N.B. The name of the operator is captured with the dots around it. -constexpr auto definedOpNameChar{ - letter || extension("$@"_ch)}; +constexpr auto definedOpNameChar{letter || + extension( + "nonstandard usage: non-alphabetic character in defined operator"_port_en_US, + "$@"_ch)}; TYPE_PARSER( space >> construct(sourced("."_ch >> some(definedOpNameChar) >> construct() / "."_ch))) diff --git a/flang/lib/Parser/io-parsers.cpp b/flang/lib/Parser/io-parsers.cpp --- a/flang/lib/Parser/io-parsers.cpp +++ b/flang/lib/Parser/io-parsers.cpp @@ -85,6 +85,7 @@ construct("ERR =" >> errLabel), construct("FILE =" >> fileNameExpr), extension( + "nonstandard usage: NAME= in place of FILE="_port_en_US, construct("NAME =" >> fileNameExpr)), construct(construct( "FORM =" >> pure(ConnectSpec::CharExpr::Kind::Form), @@ -108,15 +109,19 @@ "SIGN =" >> pure(ConnectSpec::CharExpr::Kind::Sign), scalarDefaultCharExpr)), construct("STATUS =" >> statusExpr), - extension(construct( - construct("CARRIAGECONTROL =" >> - pure(ConnectSpec::CharExpr::Kind::Carriagecontrol), - scalarDefaultCharExpr))), + extension( + "nonstandard usage: CARRIAGECONTROL="_port_en_US, + construct( + construct("CARRIAGECONTROL =" >> + pure(ConnectSpec::CharExpr::Kind::Carriagecontrol), + scalarDefaultCharExpr))), extension( + "nonstandard usage: CONVERT="_port_en_US, construct(construct( "CONVERT =" >> pure(ConnectSpec::CharExpr::Kind::Convert), scalarDefaultCharExpr))), extension( + "nonstandard usage: DISPOSE="_port_en_US, construct(construct( "DISPOSE =" >> pure(ConnectSpec::CharExpr::Kind::Dispose), scalarDefaultCharExpr))))) @@ -145,6 +150,7 @@ // rewriting in semantics when we know that CVAR is character. constexpr auto inputItemList{ extension( + "nonstandard usage: leading comma in input item list"_port_en_US, some("," >> inputItem)) || // legacy extension: leading comma optionalList(inputItem)}; @@ -226,6 +232,7 @@ // R1211 write-stmt -> WRITE ( io-control-spec-list ) [output-item-list] constexpr auto outputItemList{ extension( + "nonstandard usage: leading comma in output item list"_port_en_US, some("," >> outputItem)) || // legacy: allow leading comma optionalList(outputItem)}; @@ -486,18 +493,23 @@ construct(pure(InquireSpec::CharVar::Kind::Write), scalarDefaultCharVariable)), extension( + "nonstandard usage: CARRIAGECONTROL="_port_en_US, construct("CARRIAGECONTROL =" >> construct( pure(InquireSpec::CharVar::Kind::Carriagecontrol), scalarDefaultCharVariable))), - extension(construct( - "CONVERT =" >> construct( - pure(InquireSpec::CharVar::Kind::Convert), - scalarDefaultCharVariable))), - extension(construct( - "DISPOSE =" >> construct( - pure(InquireSpec::CharVar::Kind::Dispose), - scalarDefaultCharVariable))))) + extension( + "nonstandard usage: CONVERT="_port_en_US, + construct( + "CONVERT =" >> construct( + pure(InquireSpec::CharVar::Kind::Convert), + scalarDefaultCharVariable))), + extension( + "nonstandard usage: DISPOSE="_port_en_US, + construct( + "DISPOSE =" >> construct( + pure(InquireSpec::CharVar::Kind::Dispose), + scalarDefaultCharVariable))))) // R1230 inquire-stmt -> // INQUIRE ( inquire-spec-list ) | @@ -591,6 +603,7 @@ noInt, noInt) || // PGI/Intel extension: omitting width (and all else that follows) extension( + "nonstandard usage: abbreviated edit descriptor"_port_en_US, construct( "I" >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) || ("B"_tok / !letter /* don't occlude BN & BZ */) >> @@ -673,8 +686,9 @@ "P" >> construct( pure(format::ControlEditDesc::Kind::DP))) || extension( + "nonstandard usage: $ and \\ control edit descriptors"_port_en_US, "$" >> construct( pure(format::ControlEditDesc::Kind::Dollar)) || - "\\" >> construct( - pure(format::ControlEditDesc::Kind::Backslash)))) + "\\" >> construct( + pure(format::ControlEditDesc::Kind::Backslash)))) } // namespace Fortran::parser diff --git a/flang/lib/Parser/program-parsers.cpp b/flang/lib/Parser/program-parsers.cpp --- a/flang/lib/Parser/program-parsers.cpp +++ b/flang/lib/Parser/program-parsers.cpp @@ -54,11 +54,13 @@ // Consequently, a program unit END statement should be the last statement // on its line. We parse those END statements via unterminatedStatement() // and then skip over the end of the line here. -TYPE_PARSER(construct( - extension(skipStuffBeforeStatement >> - !nextCh >> pure>()) || - some(globalCompilerDirective || normalProgramUnit) / - skipStuffBeforeStatement)) +TYPE_PARSER( + construct(extension( + "nonstandard usage: empty source file"_port_en_US, + skipStuffBeforeStatement >> !nextCh >> + pure>()) || + some(globalCompilerDirective || normalProgramUnit) / + skipStuffBeforeStatement)) // R504 specification-part -> // [use-stmt]... [import-stmt]... [implicit-part] @@ -204,6 +206,7 @@ TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US, construct("PROGRAM" >> name / maybe(extension( + "nonstandard usage: parentheses in PROGRAM statement"_port_en_US, parenthesized(ok))))) // R1403 end-program-stmt -> END [PROGRAM [program-name]] @@ -449,10 +452,14 @@ // Semantics sorts it all out later. TYPE_PARSER(construct(expr) || construct(Parser{}) || - extension(construct( - construct("%REF" >> parenthesized(variable)))) || - extension(construct( - construct("%VAL" >> parenthesized(expr))))) + extension( + "nonstandard usage: %REF"_port_en_US, + construct(construct( + "%REF" >> parenthesized(variable)))) || + extension( + "nonstandard usage: %VAL"_port_en_US, + construct( + construct("%VAL" >> parenthesized(expr))))) // R1525 alt-return-spec -> * label TYPE_PARSER(construct(star >> label)) @@ -485,6 +492,7 @@ construct(many(prefixSpec), "FUNCTION" >> name, parenthesized(optionalList(name)), maybe(suffix)) || extension( + "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US, construct( // PGI & Intel accept "FUNCTION F" many(prefixSpec), "FUNCTION" >> name, construct>(), diff --git a/flang/lib/Parser/token-parsers.h b/flang/lib/Parser/token-parsers.h --- a/flang/lib/Parser/token-parsers.h +++ b/flang/lib/Parser/token-parsers.h @@ -655,15 +655,20 @@ // Cray and gfortran accept '$', but not as the first character. // Cray accepts '@' as well. constexpr auto otherIdChar{underscore / !"'\""_ch || - extension("$@"_ch)}; + extension( + "nonstandard usage: punctuation in name"_port_en_US, "$@"_ch)}; constexpr auto logicalTRUE{ (".TRUE."_tok || - extension(".T."_tok)) >> + extension( + "nonstandard usage: .T. spelling of .TRUE."_port_en_US, + ".T."_tok)) >> pure(true)}; constexpr auto logicalFALSE{ (".FALSE."_tok || - extension(".F."_tok)) >> + extension( + "nonstandard usage: .F. spelling of .FALSE."_port_en_US, + ".F."_tok)) >> pure(false)}; // deprecated: Hollerith literals