@@ -34,12 +34,27 @@ namespace Fortran::parser {
34
34
// for several productions; giving the "module" production priority here is a
35
35
// cleaner solution, though regrettably subtle.
36
36
// Enforcing C1547 is done in semantics.
37
+ static constexpr auto notATopLevelFunctionStmt{
38
+ // REAL FUNCTION F(10) at the top level is the first declaration
39
+ // of a main program
40
+ // REAL FUNCTION is too
41
+ // REAL FUNCTION F/1./ is too
42
+ // REAL FUNCTION F,G is too
43
+ // REAL FUNCTION F(X) is a FunctionStmt
44
+ // REAL FUNCTION F can be a FunctionStmt
45
+ declarationTypeSpec >>
46
+ many (" PURE" _tok || " IMPURE" _tok || " ELEMENTAL" _tok || " RECURSIVE" _tok ||
47
+ " NON_RECURSIVE" _tok || " MODULE" _tok) >>
48
+ " FUNCTION" _tok >>
49
+ !(name >> (extension<LanguageFeature::OmitFunctionDummies>(atEndOfStmt) ||
50
+ parenthesized (optionalList (name)) >> ok))};
37
51
static constexpr auto programUnit{
38
52
construct<ProgramUnit>(indirect (Parser<Module>{})) ||
39
- construct<ProgramUnit>(indirect (functionSubprogram)) ||
40
53
construct<ProgramUnit>(indirect (subroutineSubprogram)) ||
41
54
construct<ProgramUnit>(indirect (Parser<Submodule>{})) ||
42
55
construct<ProgramUnit>(indirect (Parser<BlockData>{})) ||
56
+ !notATopLevelFunctionStmt >>
57
+ construct<ProgramUnit>(indirect (functionSubprogram)) ||
43
58
construct<ProgramUnit>(indirect (Parser<MainProgram>{}))};
44
59
static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit /
45
60
skipMany (" ;" _tok) / space / recovery (endOfLine, SkipPast<' \n ' >{})};
@@ -532,15 +547,20 @@ TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US,
532
547
// [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
533
548
// R1526 prefix -> prefix-spec [prefix-spec]...
534
549
// R1531 dummy-arg-name -> name
535
- TYPE_CONTEXT_PARSER(" FUNCTION statement" _en_US,
536
- construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
537
- parenthesized(optionalList(name)), maybe(suffix)) ||
550
+
551
+ TYPE_PARSER(construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
552
+ parenthesized(optionalList(name)), maybe(suffix)) /
553
+ atEndOfStmt ||
554
+ construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name / atEndOfStmt,
555
+ // PGI & Intel accept "FUNCTION F"
538
556
extension<LanguageFeature::OmitFunctionDummies>(
539
557
" nonstandard usage: FUNCTION statement without dummy argument list" _port_en_US,
540
- construct<FunctionStmt>( // PGI & Intel accept "FUNCTION F"
541
- many (prefixSpec), "FUNCTION" >> name,
542
- construct<std::list<Name>>(),
543
- construct<std::optional<Suffix>>())))
558
+ pure<std::list<Name>>()),
559
+ pure<std::optional<Suffix>>()) ||
560
+ // error recovery
561
+ construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
562
+ defaulted(parenthesized(optionalList(name))), maybe(suffix)) /
563
+ checkEndOfKnownStmt)
544
564
545
565
// R1532 suffix ->
546
566
// proc-language-binding-spec [RESULT ( result-name )] |
@@ -566,11 +586,13 @@ TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_en_US,
566
586
// [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] )
567
587
// [proc-language-binding-spec]]
568
588
TYPE_PARSER(
569
- construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
570
- parenthesized(optionalList(dummyArg)), maybe(languageBindingSpec)) ||
571
- construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
572
- pure<std::list<DummyArg>>(),
573
- pure<std::optional<LanguageBindingSpec>>()))
589
+ (construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
590
+ !"(" _tok >> pure<std::list<DummyArg>>(),
591
+ pure<std::optional<LanguageBindingSpec>>()) ||
592
+ construct<SubroutineStmt>(many(prefixSpec), " SUBROUTINE" >> name,
593
+ defaulted(parenthesized(optionalList(dummyArg))),
594
+ maybe(languageBindingSpec))) /
595
+ checkEndOfKnownStmt)
574
596
575
597
// R1536 dummy-arg -> dummy-arg-name | *
576
598
TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star))
0 commit comments