[flang] Add explanatory messages to grammar for language extensions

[klausler]

Summary

Extend "extension<LanguageFeature>()" to incorporate an explanatory
message better than the current generic "nonstandard usage:".

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Parser/Fortran-parsers.cpp

constexpr auto namedIntrinsicOperator{
     ".GE." >> pure(DefinedOperator::IntrinsicOperator::GE) ||
     ".GT." >> pure(DefinedOperator::IntrinsicOperator::GT) ||
     ".NOT." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||
     ".AND." >> pure(DefinedOperator::IntrinsicOperator::AND) ||
     ".OR." >> pure(DefinedOperator::IntrinsicOperator::OR) ||
     ".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) ||
     ".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) ||
     extension<LanguageFeature::XOROperator>(
+        "nonstandard usage: .XOR. spelling of .NEQV."_port_en_US,
         ".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) ||
     extension<LanguageFeature::LogicalAbbreviations>(
+        "nonstandard usage: abbreviated logical operator"_port_en_US,
         ".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||
             ".A." >> pure(DefinedOperator::IntrinsicOperator::AND) ||
             ".O." >> pure(DefinedOperator::IntrinsicOperator::OR) ||
             extension<LanguageFeature::XOROperator>(
+                "nonstandard usage: .X. spelling of .NEQV."_port_en_US,
                 ".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))};
 
 constexpr auto intrinsicOperator{
     "**" >> pure(DefinedOperator::IntrinsicOperator::Power) ||
     "*" >> pure(DefinedOperator::IntrinsicOperator::Multiply) ||
     "//" >> pure(DefinedOperator::IntrinsicOperator::Concat) ||
     "/=" >> pure(DefinedOperator::IntrinsicOperator::NE) ||
     "/" >> pure(DefinedOperator::IntrinsicOperator::Divide) ||
     "+" >> pure(DefinedOperator::IntrinsicOperator::Add) ||
     "-" >> pure(DefinedOperator::IntrinsicOperator::Subtract) ||
     "<=" >> pure(DefinedOperator::IntrinsicOperator::LE) ||
     extension<LanguageFeature::AlternativeNE>(
+        "nonstandard usage: <> spelling of /= or .NE."_port_en_US,
         "<>" >> pure(DefinedOperator::IntrinsicOperator::NE)) ||
     "<" >> pure(DefinedOperator::IntrinsicOperator::LT) ||
     "==" >> pure(DefinedOperator::IntrinsicOperator::EQ) ||
     ">=" >> pure(DefinedOperator::IntrinsicOperator::GE) ||
     ">" >> pure(DefinedOperator::IntrinsicOperator::GT) ||
     namedIntrinsicOperator};
 
 // R609 defined-operator ->
construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||
                 construct<DeclarationTypeSpec>(
                     "( * )" >> construct<DeclarationTypeSpec::TypeStar>())) ||
         "CLASS" >> parenthesized(construct<DeclarationTypeSpec>(
                                      construct<DeclarationTypeSpec::Class>(
                                          derivedTypeSpec)) ||
                        construct<DeclarationTypeSpec>("*" >>
                            construct<DeclarationTypeSpec::ClassStar>())) ||
         extension<LanguageFeature::DECStructures>(
+            "nonstandard usage: STRUCTURE"_port_en_US,
             construct<DeclarationTypeSpec>(
                 // As is also done for the STRUCTURE statement, the name of
                 // the structure includes the surrounding slashes to avoid
                 // name clashes.
                 construct<DeclarationTypeSpec::Record>(
                     "RECORD" >> sourced("/" >> name / "/")))))
 
 // R704 intrinsic-type-spec ->
 //        integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
 //        COMPLEX [kind-selector] | CHARACTER [char-selector] |
 //        LOGICAL [kind-selector]
 // Extensions: DOUBLE COMPLEX, BYTE
 TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
     first(construct<IntrinsicTypeSpec>(integerTypeSpec),
         construct<IntrinsicTypeSpec>(
             construct<IntrinsicTypeSpec::Real>("REAL" >> maybe(kindSelector))),
         construct<IntrinsicTypeSpec>("DOUBLE PRECISION" >>
             construct<IntrinsicTypeSpec::DoublePrecision>()),
         construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Complex>(
             "COMPLEX" >> maybe(kindSelector))),
         construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
             "CHARACTER" >> maybe(Parser<CharSelector>{}))),
         construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
             "LOGICAL" >> maybe(kindSelector))),
-        extension<LanguageFeature::DoubleComplex>(construct<IntrinsicTypeSpec>(
-            "DOUBLE COMPLEX" >> construct<IntrinsicTypeSpec::DoubleComplex>())),
-        extension<LanguageFeature::Byte>(
+        extension<LanguageFeature::DoubleComplex>(
+            "nonstandard usage: DOUBLE COMPLEX"_port_en_US,
+            construct<IntrinsicTypeSpec>("DOUBLE COMPLEX" >>
+                construct<IntrinsicTypeSpec::DoubleComplex>())),
+        extension<LanguageFeature::Byte>("nonstandard usage: BYTE"_port_en_US,
             construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
                 "BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
 
 // R705 integer-type-spec -> INTEGER [kind-selector]
 TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
 
 // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )
 // Legacy extension: kind-selector -> * digit-string
 TYPE_PARSER(construct<KindSelector>(
                 parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
-    extension<LanguageFeature::StarKind>(construct<KindSelector>(
-        construct<KindSelector::StarSize>("*" >> digitString64 / spaceCheck))))
+    extension<LanguageFeature::StarKind>(
+        "nonstandard usage: TYPE*KIND syntax"_port_en_US,
+        construct<KindSelector>(construct<KindSelector::StarSize>(
+            "*" >> digitString64 / spaceCheck))))
 
 // R707 signed-int-literal-constant -> [sign] int-literal-constant
 TYPE_PARSER(sourced(construct<SignedIntLiteralConstant>(
     SignedIntLiteralConstantWithoutKind{}, maybe(underscore >> kindParam))))
 
 // R708 int-literal-constant -> digit-string [_ kind-param]
 // The negated look-ahead for a trailing underscore prevents misrecognition
 // when the digit string is a numeric kind parameter of a character literal.

 // R714 real-literal-constant ->
 //        significand [exponent-letter exponent] [_ kind-param] |
 //        digit-string exponent-letter exponent [_ kind-param]
 // R715 significand -> digit-string . [digit-string] | . digit-string
 // R716 exponent-letter -> E | D
 // Extension: Q
 // R717 exponent -> signed-digit-string
 constexpr auto exponentPart{
-    ("ed"_ch || extension<LanguageFeature::QuadPrecision>("q"_ch)) >>
+    ("ed"_ch ||
+        extension<LanguageFeature::QuadPrecision>(
+            "nonstandard usage: Q exponent"_port_en_US, "q"_ch)) >>
     SignedDigitString{}};
 
 TYPE_CONTEXT_PARSER("REAL literal constant"_en_US,
     space >>
         construct<RealLiteralConstant>(
             sourced((digitString >> "."_ch >>
                             !(some(letter) >>
                                 "."_ch /* don't misinterpret 1.AND. */) >>

 //        [lbracket coarray-spec rbracket] [* char-length]
 //        [component-initialization]
 TYPE_CONTEXT_PARSER("component declaration"_en_US,
     construct<ComponentDecl>(name, maybe(Parser<ComponentArraySpec>{}),
         maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
 // The source field of the Name will be replaced with a distinct generated name.
 TYPE_CONTEXT_PARSER("%FILL item"_en_US,
     extension<LanguageFeature::DECStructures>(
+        "nonstandard usage: %FILL"_port_en_US,
         construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),
             maybe(Parser<ComponentArraySpec>{}), maybe("*" >> charLength))))
 TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||
     construct<ComponentOrFill>(Parser<FillDecl>{}))
 
 // R740 component-array-spec ->
 //        explicit-shape-spec-list | deferred-shape-spec-list
 // N.B. Parenthesized here rather than around references to this production.

 // R743 component-initialization ->
 //        = constant-expr | => null-init | => initial-data-target
 // R805 initialization ->
 //        = constant-expr | => null-init | => initial-data-target
 // Universal extension: initialization -> / data-stmt-value-list /
 TYPE_PARSER(construct<Initialization>("=>" >> nullInit) ||
     construct<Initialization>("=>" >> initialDataTarget) ||
     construct<Initialization>("=" >> constantExpr) ||
-    extension<LanguageFeature::SlashInitialization>(construct<Initialization>(
+    extension<LanguageFeature::SlashInitialization>(
+        "nonstandard usage: /initialization/"_port_en_US,
+        construct<Initialization>(
             "/" >> nonemptyList("expected values"_err_en_US,
                        indirect(Parser<DataStmtValue>{})) /
                 "/")))
 
 // R745 private-components-stmt -> PRIVATE
 // R747 binding-private-stmt -> PRIVATE
 TYPE_PARSER(construct<PrivateStmt>("PRIVATE"_tok))
 
 // R746 type-bound-procedure-part ->
 //        contains-stmt [binding-private-stmt] [type-bound-proc-binding]...
 TYPE_CONTEXT_PARSER("type bound procedure part"_en_US,
construct<TypeDeclarationStmt>(declarationTypeSpec,
         defaulted("," >> nonemptyList(Parser<AttrSpec>{})) / "::",
         nonemptyList("expected entity declarations"_err_en_US, entityDecl)) ||
     // C806: no initializers allowed without colons ("REALA=1" is ambiguous)
     construct<TypeDeclarationStmt>(declarationTypeSpec,
         construct<std::list<AttrSpec>>(),
         nonemptyList("expected entity declarations"_err_en_US,
             entityDeclWithoutEqInit)) ||
     // PGI-only extension: comma in place of doubled colons
-    extension<LanguageFeature::MissingColons>(construct<TypeDeclarationStmt>(
-        declarationTypeSpec, defaulted("," >> nonemptyList(Parser<AttrSpec>{})),
+    extension<LanguageFeature::MissingColons>(
+        "nonstandard usage: ',' in place of '::'"_port_en_US,
+        construct<TypeDeclarationStmt>(declarationTypeSpec,
+            defaulted("," >> nonemptyList(Parser<AttrSpec>{})),
             withMessage("expected entity declarations"_err_en_US,
                 "," >> nonemptyList(entityDecl)))))
 
 // R802 attr-spec ->
 //        access-spec | ALLOCATABLE | ASYNCHRONOUS |
 //        CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
 //        DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
 //        INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
 //        PROTECTED | SAVE | TARGET | VALUE | VOLATILE
 TYPE_PARSER(construct<AttrSpec>(accessSpec) ||

 // components can be ambiguous with a scalar-constant-subobject.
 // So we parse literal constants, designator, null-init, and
 // structure-constructor, so that semantics can figure things out later
 // with the symbol table.
 TYPE_PARSER(sourced(first(construct<DataStmtConstant>(literalConstant),
     construct<DataStmtConstant>(signedRealLiteralConstant),
     construct<DataStmtConstant>(signedIntLiteralConstant),
     extension<LanguageFeature::SignedComplexLiteral>(
+        "nonstandard usage: signed COMPLEX literal"_port_en_US,
         construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),
     construct<DataStmtConstant>(nullInit),
     construct<DataStmtConstant>(indirect(designator) / !"("_tok),
     construct<DataStmtConstant>(Parser<StructureConstructor>{}))))
 
 // R848 dimension-stmt ->
 //        DIMENSION [::] array-name ( array-spec )
 //        [, array-name ( array-spec )]...
TYPE_PARSER(
     construct<OptionalStmt>("OPTIONAL" >> maybe("::"_tok) >> listOfNames))
 
 // R851 parameter-stmt -> PARAMETER ( named-constant-def-list )
 // Legacy extension: omitted parentheses, no implicit typing from names
 TYPE_CONTEXT_PARSER("PARAMETER statement"_en_US,
     construct<ParameterStmt>(
         "PARAMETER" >> parenthesized(nonemptyList(Parser<NamedConstantDef>{}))))
 TYPE_CONTEXT_PARSER("old style PARAMETER statement"_en_US,
-    extension<LanguageFeature::OldStyleParameter>(construct<OldParameterStmt>(
+    extension<LanguageFeature::OldStyleParameter>(
+        "nonstandard usage: PARAMETER without parentheses"_port_en_US,
+        construct<OldParameterStmt>(
             "PARAMETER" >> nonemptyList(Parser<NamedConstantDef>{}))))
 
 // R852 named-constant-def -> named-constant = constant-expr
 TYPE_PARSER(construct<NamedConstantDef>(namedConstant, "=" >> constantExpr))
 
 // R853 pointer-stmt -> POINTER [::] pointer-decl-list
 TYPE_PARSER(construct<PointerStmt>("POINTER" >> maybe("::"_tok) >>
     nonemptyList(
         "expected pointer declarations"_err_en_US, Parser<PointerDecl>{})))

 //  maybe an [image-selector].
 //  If it's a substring, it ends with (substring-range).
 TYPE_CONTEXT_PARSER("designator"_en_US,
     sourced(construct<Designator>(substring) || construct<Designator>(dataRef)))
 
 constexpr auto percentOrDot{"%"_tok ||
     // legacy VAX extension for RECORD field access
     extension<LanguageFeature::DECStructures>(
+        "nonstandard usage: component access with '.' in place of '%'"_port_en_US,
         "."_tok / lookAhead(OldStructureComponentName{}))};
 
 // R902 variable -> designator | function-reference
 // This production appears to be left-recursive in the grammar via
 //   function-reference ->  procedure-designator -> proc-component-ref ->
 //     scalar-variable
 // and would be so if we were to allow functions to be called via procedure
 // pointer components within derived type results of other function references
"DIR$ IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
                              defaulted(parenthesized(some("tkr"_ch))), name))};
 TYPE_PARSER(beginDirective >>
     sourced(construct<CompilerDirective>(ignore_tkr) ||
         construct<CompilerDirective>(
             "DIR$" >> many(construct<CompilerDirective::NameValue>(name,
                           maybe(("="_tok || ":"_tok) >> digitString64))))) /
         endDirective)
 
-TYPE_PARSER(extension<LanguageFeature::CrayPointer>(construct<BasedPointerStmt>(
+TYPE_PARSER(extension<LanguageFeature::CrayPointer>(
+    "nonstandard usage: based POINTER"_port_en_US,
+    construct<BasedPointerStmt>(
         "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
                          construct<BasedPointer>("(" >> objectName / ",",
                              objectName, maybe(Parser<ArraySpec>{}) / ")")))))
 
 // Subtle: the name includes the surrounding slashes, which avoids
 // clashes with other uses of the name in the same scope.
 TYPE_PARSER(construct<StructureStmt>(
     "STRUCTURE" >> maybe(sourced("/" >> name / "/")), optionalList(entityDecl)))
 
 constexpr auto nestedStructureDef{
     CONTEXT_PARSER("nested STRUCTURE definition"_en_US,
         construct<StructureDef>(statement(NestedStructureStmt{}),
             many(Parser<StructureField>{}),
             statement(construct<StructureDef::EndStructureStmt>(
                 "END STRUCTURE"_tok))))};
 
 TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) ||
     construct<StructureField>(indirect(Parser<Union>{})) ||
     construct<StructureField>(indirect(nestedStructureDef)))
 
 TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US,
-    extension<LanguageFeature::DECStructures>(construct<StructureDef>(
-        statement(Parser<StructureStmt>{}), many(Parser<StructureField>{}),
-        statement(
-            construct<StructureDef::EndStructureStmt>("END STRUCTURE"_tok)))))
+    extension<LanguageFeature::DECStructures>(
+        "nonstandard usage: STRUCTURE"_port_en_US,
+        construct<StructureDef>(statement(Parser<StructureStmt>{}),
+            many(Parser<StructureField>{}),
+            statement(construct<StructureDef::EndStructureStmt>(
+                "END STRUCTURE"_tok)))))
 
 TYPE_CONTEXT_PARSER("UNION definition"_en_US,
     construct<Union>(statement(construct<Union::UnionStmt>("UNION"_tok)),
         many(Parser<Map>{}),
         statement(construct<Union::EndUnionStmt>("END UNION"_tok))))
 
 TYPE_CONTEXT_PARSER("MAP definition"_en_US,
     construct<Map>(statement(construct<Map::MapStmt>("MAP"_tok)),

flang/lib/Parser/basic-parsers.h

 
 // If a is a parser for some nonstandard language feature LF, extension<LF>(a)
 // is a parser that optionally enabled, sets a strict conformance violation
 // flag, and may emit a warning message, if those are enabled.
 template <LanguageFeature LF, typename PA> class NonstandardParser {
 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<resultType> Parse(ParseState &state) const {
     if (UserState * ustate{state.userState()}) {
       if (!ustate->features().IsEnabled(LF)) {
         return std::nullopt;
       }
     }
     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 <LanguageFeature LF, typename PA>
-inline constexpr auto extension(PA parser) {
-  return NonstandardParser<LF, PA>(parser);
+inline constexpr auto extension(MessageFixedText feature, PA parser) {
+  return NonstandardParser<LF, PA>(parser, feature);
 }
 
 // If a is a parser for some deprecated or deleted language feature LF,
 // deprecated<LF>(a) is a parser that is optionally enabled, sets a strict
 // conformance violation flag, and may emit a warning message, if enabled.
 template <LanguageFeature LF, typename PA> class DeprecatedParser {
 public:
   using resultType = typename PA::resultType;

flang/lib/Parser/executable-parsers.cpp

withMessage("expected execution part construct"_err_en_US,
             first(construct<ExecutionPartConstruct>(executableConstruct),
                 construct<ExecutionPartConstruct>(
                     statement(indirect(formatStmt))),
                 construct<ExecutionPartConstruct>(
                     statement(indirect(entryStmt))),
                 construct<ExecutionPartConstruct>(
                     statement(indirect(dataStmt))),
                 extension<LanguageFeature::ExecutionPartNamelist>(
+                    "nonstandard usage: NAMELIST in execution part"_port_en_US,
                     construct<ExecutionPartConstruct>(
                         statement(indirect(Parser<NamelistStmt>{})))),
                 obsoleteExecutionPartConstruct))),
     construct<ExecutionPartConstruct>(executionPartErrorRecovery)))
 
 // R509 execution-part -> executable-construct [execution-part-construct]...
 TYPE_CONTEXT_PARSER("execution part"_en_US,
     construct<ExecutionPart>(many(executionPartConstruct)))

flang/lib/Parser/expr-parsers.cpp

TYPE_PARSER(construct<AcSpec>(maybe(typeSpec / "::"),
                 nonemptyList("expected array constructor values"_err_en_US,
                     Parser<AcValue>{})) ||
     construct<AcSpec>(typeSpec / "::"))
 
 // R773 ac-value -> expr | ac-implied-do
 TYPE_PARSER(
     // PGI/Intel extension: accept triplets in array constructors
     extension<LanguageFeature::TripletInArrayConstructor>(
+        "nonstandard usage: triplet in array constructor"_port_en_US,
         construct<AcValue>(construct<AcValue::Triplet>(scalarIntExpr,
             ":" >> scalarIntExpr, maybe(":" >> scalarIntExpr)))) ||
     construct<AcValue>(indirect(expr)) ||
     construct<AcValue>(indirect(Parser<AcImpliedDo>{})))
 
 // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control )
 TYPE_PARSER(parenthesized(
     construct<AcImpliedDo>(nonemptyList(Parser<AcValue>{} / lookAhead(","_tok)),
first(construct<Expr>(indirect(Parser<CharLiteralConstantSubstring>{})),
         construct<Expr>(literalConstant),
         construct<Expr>(construct<Expr::Parentheses>(parenthesized(expr))),
         construct<Expr>(indirect(functionReference) / !"("_tok),
         construct<Expr>(designator / !"("_tok),
         construct<Expr>(Parser<StructureConstructor>{}),
         construct<Expr>(Parser<ArrayConstructor>{}),
         // PGI/XLF extension: COMPLEX constructor (x,y)
         extension<LanguageFeature::ComplexConstructor>(
+            "nonstandard usage: generalized COMPLEX constructor"_port_en_US,
             construct<Expr>(parenthesized(
                 construct<Expr::ComplexConstructor>(expr, "," >> expr)))),
-        extension<LanguageFeature::PercentLOC>(construct<Expr>("%LOC" >>
-            parenthesized(construct<Expr::PercentLoc>(indirect(variable)))))))};
+        extension<LanguageFeature::PercentLOC>(
+            "nonstandard usage: %LOC"_port_en_US,
+            construct<Expr>("%LOC" >> parenthesized(construct<Expr::PercentLoc>(
+                                          indirect(variable)))))))};
 
 // R1002 level-1-expr -> [defined-unary-op] primary
 // TODO: Reasonable extension: permit multiple defined-unary-ops
 constexpr auto level1Expr{sourced(
     first(primary, // must come before define op to resolve .TRUE._8 ambiguity
         construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)),
         extension<LanguageFeature::SignedPrimary>(
+            "nonstandard usage: signed primary"_port_en_US,
             construct<Expr>(construct<Expr::UnaryPlus>("+" >> primary))),
         extension<LanguageFeature::SignedPrimary>(
+            "nonstandard usage: signed primary"_port_en_US,
             construct<Expr>(construct<Expr::Negate>("-" >> primary)))))};
 
 // R1004 mult-operand -> level-1-expr [power-op mult-operand]
 // R1007 power-op -> **
 // Exponentiation (**) is Fortran's only right-associative binary operation.
 struct MultOperand {
   using resultType = Expr;
   constexpr MultOperand() {}
if (result) {
         return Expr{Expr::GT(std::move(result).value(), std::move(right))};
       }};
       auto more{attempt(
           sourced((".LT."_tok || "<"_tok) >> applyLambda(lt, level3Expr) ||
               (".LE."_tok || "<="_tok) >> applyLambda(le, level3Expr) ||
               (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) ||
               (".NE."_tok || "/="_tok ||
                   extension<LanguageFeature::AlternativeNE>(
+                      "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) ||
               (".GT."_tok || ">"_tok) >> applyLambda(gt, level3Expr)))};
       if (std::optional<Expr> next{more.Parse(state)}) {
         next->source.ExtendToCover(source);
         return next;
       }
struct AndOperand {
   static inline std::optional<Expr> Parse(ParseState &);
 };
 constexpr AndOperand andOperand;
 
 // Match a logical operator or, optionally, its abbreviation.
 inline constexpr auto logicalOp(const char *op, const char *abbrev) {
   return TokenStringMatch{op} ||
       extension<LanguageFeature::LogicalAbbreviations>(
+          "nonstandard usage: abbreviated LOGICAL operator"_port_en_US,
           TokenStringMatch{abbrev});
 }
 
 inline std::optional<Expr> AndOperand::Parse(ParseState &state) {
   static constexpr auto notOp{attempt(logicalOp(".NOT.", ".N.") >> andOperand)};
   if (std::optional<Expr> negation{notOp.Parse(state)}) {
     return Expr{Expr::NOT{std::move(*negation)}};
   } else {
if (result) {
         return Expr{Expr::EQV(std::move(result).value(), std::move(right))};
       }};
       std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) {
         return Expr{Expr::NEQV(std::move(result).value(), std::move(right))};
       }};
       auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) ||
           (".NEQV."_tok ||
               extension<LanguageFeature::XOROperator>(
+                  "nonstandard usage: .XOR./.X. spelling of .NEQV."_port_en_US,
                   logicalOp(".XOR.", ".X."))) >>
               applyLambda(neqv, equivOperand)))};
       while (std::optional<Expr> next{more.Parse(state)}) {
         result = std::move(next);
         result->source.ExtendToCover(source);
       }
     }
     return result;

 // R1003 defined-unary-op -> . letter [letter]... .
 // R1023 defined-binary-op -> . letter [letter]... .
 // R1414 local-defined-operator -> defined-unary-op | defined-binary-op
 // R1415 use-defined-operator -> defined-unary-op | defined-binary-op
 // C1003 A defined operator must be distinct from logical literal constants
 // 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<LanguageFeature::PunctuationInNames>("$@"_ch)};
+constexpr auto definedOpNameChar{letter ||
+    extension<LanguageFeature::PunctuationInNames>(
+        "nonstandard usage: non-alphabetic character in defined operator"_port_en_US,
+        "$@"_ch)};
 TYPE_PARSER(
     space >> construct<DefinedOpName>(sourced("."_ch >>
                  some(definedOpNameChar) >> construct<Name>() / "."_ch)))
 
 // R1028 specification-expr -> scalar-int-expr
 TYPE_PARSER(construct<SpecificationExpr>(scalarIntExpr))
 
 // R1032 assignment-stmt -> variable = expr

flang/lib/Parser/io-parsers.cpp

construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "DELIM =" >> pure(ConnectSpec::CharExpr::Kind::Delim),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "ENCODING =" >> pure(ConnectSpec::CharExpr::Kind::Encoding),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>("ERR =" >> errLabel),
     construct<ConnectSpec>("FILE =" >> fileNameExpr),
     extension<LanguageFeature::FileName>(
+        "nonstandard usage: NAME= in place of FILE="_port_en_US,
         construct<ConnectSpec>("NAME =" >> fileNameExpr)),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "FORM =" >> pure(ConnectSpec::CharExpr::Kind::Form),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>("IOMSG =" >> msgVariable),
     construct<ConnectSpec>("IOSTAT =" >> statVariable),
     construct<ConnectSpec>(construct<ConnectSpec::Newunit>(
         "NEWUNIT =" >> scalar(integer(variable)))),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "PAD =" >> pure(ConnectSpec::CharExpr::Kind::Pad),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "POSITION =" >> pure(ConnectSpec::CharExpr::Kind::Position),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>(
         construct<ConnectSpec::Recl>("RECL =" >> scalarIntExpr)),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "ROUND =" >> pure(ConnectSpec::CharExpr::Kind::Round),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
         "SIGN =" >> pure(ConnectSpec::CharExpr::Kind::Sign),
         scalarDefaultCharExpr)),
     construct<ConnectSpec>("STATUS =" >> statusExpr),
-    extension<LanguageFeature::Carriagecontrol>(construct<ConnectSpec>(
+    extension<LanguageFeature::Carriagecontrol>(
+        "nonstandard usage: CARRIAGECONTROL="_port_en_US,
+        construct<ConnectSpec>(
             construct<ConnectSpec::CharExpr>("CARRIAGECONTROL =" >>
                     pure(ConnectSpec::CharExpr::Kind::Carriagecontrol),
                 scalarDefaultCharExpr))),
     extension<LanguageFeature::Convert>(
+        "nonstandard usage: CONVERT="_port_en_US,
         construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
             "CONVERT =" >> pure(ConnectSpec::CharExpr::Kind::Convert),
             scalarDefaultCharExpr))),
     extension<LanguageFeature::Dispose>(
+        "nonstandard usage: DISPOSE="_port_en_US,
         construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
             "DISPOSE =" >> pure(ConnectSpec::CharExpr::Kind::Dispose),
             scalarDefaultCharExpr)))))
 
 // R1209 close-spec ->
 //         [UNIT =] file-unit-number | IOSTAT = scalar-int-variable |
 //         IOMSG = iomsg-variable | ERR = label |
 //         STATUS = scalar-default-char-expr

 //         READ ( io-control-spec-list ) [input-item-list] |
 //         READ format [, input-item-list]
 // The ambiguous READ(CVAR) is parsed as if CVAR were the unit.
 // As Fortran doesn't have internal unformatted I/O, it should
 // be parsed as if (CVAR) were a format; this is corrected by
 // rewriting in semantics when we know that CVAR is character.
 constexpr auto inputItemList{
     extension<LanguageFeature::IOListLeadingComma>(
+        "nonstandard usage: leading comma in input item list"_port_en_US,
         some("," >> inputItem)) || // legacy extension: leading comma
     optionalList(inputItem)};
 
 TYPE_CONTEXT_PARSER("READ statement"_en_US,
     construct<ReadStmt>("READ (" >>
             construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit),
         "," >> construct<std::optional<Format>>(format),
         defaulted("," >> nonemptyList(ioControlSpec)) / ")", inputItemList) ||
construct<IoControlSpec>("SIGN =" >>
         construct<IoControlSpec::CharExpr>(
             pure(IoControlSpec::CharExpr::Kind::Sign), scalarDefaultCharExpr)),
     construct<IoControlSpec>(
         "SIZE =" >> construct<IoControlSpec::Size>(scalarIntVariable))))
 
 // R1211 write-stmt -> WRITE ( io-control-spec-list ) [output-item-list]
 constexpr auto outputItemList{
     extension<LanguageFeature::IOListLeadingComma>(
+        "nonstandard usage: leading comma in output item list"_port_en_US,
         some("," >> outputItem)) || // legacy: allow leading comma
     optionalList(outputItem)};
 
 TYPE_CONTEXT_PARSER("WRITE statement"_en_US,
     construct<WriteStmt>("WRITE (" >>
             construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit),
         "," >> construct<std::optional<Format>>(format),
         defaulted("," >> nonemptyList(ioControlSpec)) / ")", outputItemList) ||
TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
     construct<InquireSpec>(
         "UNFORMATTED =" >> construct<InquireSpec::CharVar>(
                                pure(InquireSpec::CharVar::Kind::Unformatted),
                                scalarDefaultCharVariable)),
     construct<InquireSpec>("WRITE =" >>
         construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Write),
             scalarDefaultCharVariable)),
     extension<LanguageFeature::Carriagecontrol>(
+        "nonstandard usage: CARRIAGECONTROL="_port_en_US,
         construct<InquireSpec>("CARRIAGECONTROL =" >>
             construct<InquireSpec::CharVar>(
                 pure(InquireSpec::CharVar::Kind::Carriagecontrol),
                 scalarDefaultCharVariable))),
-    extension<LanguageFeature::Convert>(construct<InquireSpec>(
+    extension<LanguageFeature::Convert>(
+        "nonstandard usage: CONVERT="_port_en_US,
+        construct<InquireSpec>(
             "CONVERT =" >> construct<InquireSpec::CharVar>(
                                pure(InquireSpec::CharVar::Kind::Convert),
                                scalarDefaultCharVariable))),
-    extension<LanguageFeature::Dispose>(construct<InquireSpec>(
+    extension<LanguageFeature::Dispose>(
+        "nonstandard usage: DISPOSE="_port_en_US,
+        construct<InquireSpec>(
             "DISPOSE =" >> construct<InquireSpec::CharVar>(
                                pure(InquireSpec::CharVar::Kind::Dispose),
                                scalarDefaultCharVariable)))))
 
 // R1230 inquire-stmt ->
 //         INQUIRE ( inquire-spec-list ) |
 //         INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list
 TYPE_CONTEXT_PARSER("INQUIRE statement"_en_US,
     "INQUIRE" >>
         (construct<InquireStmt>(
              parenthesized(nonemptyList(Parser<InquireSpec>{}))) ||
construct<format::IntrinsicTypeDataEditDesc>(
         "G" >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) ||
             "L" >> pure(format::IntrinsicTypeDataEditDesc::Kind::L),
         mandatoryWidth, noInt, noInt) ||
     construct<format::IntrinsicTypeDataEditDesc>(
         "A" >> pure(format::IntrinsicTypeDataEditDesc::Kind::A), maybe(width),
         noInt, noInt) ||
     // PGI/Intel extension: omitting width (and all else that follows)
     extension<LanguageFeature::AbbreviatedEditDescriptor>(
+        "nonstandard usage: abbreviated edit descriptor"_port_en_US,
         construct<format::IntrinsicTypeDataEditDesc>(
             "I" >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) ||
                 ("B"_tok / !letter /* don't occlude BN & BZ */) >>
                     pure(format::IntrinsicTypeDataEditDesc::Kind::B) ||
                 "O" >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) ||
                 "Z" >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z) ||
                 "F" >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) ||
                 ("D"_tok / !letter /* don't occlude DT, DC, & DP */) >>
"R" >> ("U" >> construct<format::ControlEditDesc>(
                           pure(format::ControlEditDesc::Kind::RC)) ||
                "P" >> construct<format::ControlEditDesc>(
                           pure(format::ControlEditDesc::Kind::RP))) ||
     "D" >> ("C" >> construct<format::ControlEditDesc>(
                        pure(format::ControlEditDesc::Kind::DC)) ||
                "P" >> construct<format::ControlEditDesc>(
                           pure(format::ControlEditDesc::Kind::DP))) ||
     extension<LanguageFeature::AdditionalFormats>(
+        "nonstandard usage: $ and \\ control edit descriptors"_port_en_US,
         "$" >> construct<format::ControlEditDesc>(
                    pure(format::ControlEditDesc::Kind::Dollar)) ||
             "\\" >> construct<format::ControlEditDesc>(
                         pure(format::ControlEditDesc::Kind::Backslash))))
 } // namespace Fortran::parser

flang/lib/Parser/program-parsers.cpp

 
 // R501 program -> program-unit [program-unit]...
 // This is the top-level production for the Fortran language.
 // F'2018 6.3.1 defines a program unit as a sequence of one or more lines,
 // implying that a line can't be part of two distinct program units.
 // 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<Program>(
-    extension<LanguageFeature::EmptySourceFile>(skipStuffBeforeStatement >>
-        !nextCh >> pure<std::list<ProgramUnit>>()) ||
+TYPE_PARSER(
+    construct<Program>(extension<LanguageFeature::EmptySourceFile>(
+                           "nonstandard usage: empty source file"_port_en_US,
+                           skipStuffBeforeStatement >> !nextCh >>
+                               pure<std::list<ProgramUnit>>()) ||
         some(globalCompilerDirective || normalProgramUnit) /
             skipStuffBeforeStatement))
 
 // R504 specification-part ->
 //         [use-stmt]... [import-stmt]... [implicit-part]
 //         [declaration-construct]...
 TYPE_CONTEXT_PARSER("specification part"_en_US,
     construct<SpecificationPart>(many(openaccDeclarativeConstruct),
         many(openmpDeclarativeConstruct), many(indirect(compilerDirective)),
         many(statement(indirect(Parser<UseStmt>{}))),
construct<MainProgram>(maybe(statement(Parser<ProgramStmt>{})),
         specificationPart, executionPart, maybe(internalSubprogramPart),
         unterminatedStatement(Parser<EndProgramStmt>{})))
 
 // R1402 program-stmt -> PROGRAM program-name
 // PGI allows empty parentheses after the name.
 TYPE_CONTEXT_PARSER("PROGRAM statement"_en_US,
     construct<ProgramStmt>("PROGRAM" >> name /
             maybe(extension<LanguageFeature::ProgramParentheses>(
+                "nonstandard usage: parentheses in PROGRAM statement"_port_en_US,
                 parenthesized(ok)))))
 
 // R1403 end-program-stmt -> END [PROGRAM [program-name]]
 TYPE_CONTEXT_PARSER("END PROGRAM statement"_en_US,
     construct<EndProgramStmt>(recovery(
         "END PROGRAM" >> maybe(name) || bareEnd, progUnitEndStmtErrorRecovery)))
 
 // R1404 module ->

 //         alt-return-spec
 // N.B. the "procedure-name" and "proc-component-ref" alternatives can't
 // yet be distinguished from "variable", many instances of which can't be
 // distinguished from "expr" anyway (to do so would misparse structure
 // constructors and function calls as array elements).
 // Semantics sorts it all out later.
 TYPE_PARSER(construct<ActualArg>(expr) ||
     construct<ActualArg>(Parser<AltReturnSpec>{}) ||
-    extension<LanguageFeature::PercentRefAndVal>(construct<ActualArg>(
-        construct<ActualArg::PercentRef>("%REF" >> parenthesized(variable)))) ||
-    extension<LanguageFeature::PercentRefAndVal>(construct<ActualArg>(
+    extension<LanguageFeature::PercentRefAndVal>(
+        "nonstandard usage: %REF"_port_en_US,
+        construct<ActualArg>(construct<ActualArg::PercentRef>(
+            "%REF" >> parenthesized(variable)))) ||
+    extension<LanguageFeature::PercentRefAndVal>(
+        "nonstandard usage: %VAL"_port_en_US,
+        construct<ActualArg>(
             construct<ActualArg::PercentVal>("%VAL" >> parenthesized(expr)))))
 
 // R1525 alt-return-spec -> * label
 TYPE_PARSER(construct<AltReturnSpec>(star >> label))
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
 //         NON_RECURSIVE | PURE | RECURSIVE
 TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),

 // R1530 function-stmt ->
 //         [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
 // R1526 prefix -> prefix-spec [prefix-spec]...
 // R1531 dummy-arg-name -> name
 TYPE_CONTEXT_PARSER("FUNCTION statement"_en_US,
     construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
         parenthesized(optionalList(name)), maybe(suffix)) ||
         extension<LanguageFeature::OmitFunctionDummies>(
+            "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US,
             construct<FunctionStmt>( // PGI & Intel accept "FUNCTION F"
                 many(prefixSpec), "FUNCTION" >> name,
                 construct<std::list<Name>>(),
                 construct<std::optional<Suffix>>())))
 
 // R1532 suffix ->
 //         proc-language-binding-spec [RESULT ( result-name )] |
 //         RESULT ( result-name ) [proc-language-binding-spec]

flang/lib/Parser/token-parsers.h

 
 // Characters besides letters and digits that may appear in names.
 // N.B. Don't accept an underscore if it is immediately followed by a
 // quotation mark, so that kindParam_"character literal" is parsed properly.
 // PGI and ifort accept '$' in identifiers, even as the initial character.
 // Cray and gfortran accept '$', but not as the first character.
 // Cray accepts '@' as well.
 constexpr auto otherIdChar{underscore / !"'\""_ch ||
-    extension<LanguageFeature::PunctuationInNames>("$@"_ch)};
+    extension<LanguageFeature::PunctuationInNames>(
+        "nonstandard usage: punctuation in name"_port_en_US, "$@"_ch)};
 
 constexpr auto logicalTRUE{
     (".TRUE."_tok ||
-        extension<LanguageFeature::LogicalAbbreviations>(".T."_tok)) >>
+        extension<LanguageFeature::LogicalAbbreviations>(
+            "nonstandard usage: .T. spelling of .TRUE."_port_en_US,
+            ".T."_tok)) >>
     pure(true)};
 constexpr auto logicalFALSE{
     (".FALSE."_tok ||
-        extension<LanguageFeature::LogicalAbbreviations>(".F."_tok)) >>
+        extension<LanguageFeature::LogicalAbbreviations>(
+            "nonstandard usage: .F. spelling of .FALSE."_port_en_US,
+            ".F."_tok)) >>
     pure(false)};
 
 // deprecated: Hollerith literals
 constexpr auto rawHollerithLiteral{
     deprecated<LanguageFeature::Hollerith>(HollerithLiteral{})};
 
 template <typename A> constexpr decltype(auto) verbatim(A x) {
   return sourced(construct<Verbatim>(x));
 }
 
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TOKEN_PARSERS_H_