Index: flang/include/flang/Semantics/tools.h =================================================================== --- flang/include/flang/Semantics/tools.h +++ flang/include/flang/Semantics/tools.h @@ -96,7 +96,8 @@ bool IsBindCProcedure(const Symbol &); bool IsBindCProcedure(const Scope &); bool IsProcName(const Symbol &); // proc-name -bool IsFunctionResultWithSameNameAsFunction(const Symbol &); +// Returns a pointer to the function's symbol when true, else null +const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &); bool IsOrContainsEventOrLockComponent(const Symbol &); bool CanBeTypeBoundProc(const Symbol *); // Does a non-PARAMETER symbol have explicit initialization with =value or Index: flang/lib/Semantics/expression.cpp =================================================================== --- flang/lib/Semantics/expression.cpp +++ flang/lib/Semantics/expression.cpp @@ -2781,33 +2781,43 @@ "No operator %s defined for %s and %s"_err_en_US, nullptr, true); } -static void CheckFuncRefToArrayElementRefHasSubscripts( - semantics::SemanticsContext &context, +// Returns true if a parsed function reference should be converted +// into an array element reference. +static bool CheckFuncRefToArrayElement(semantics::SemanticsContext &context, const parser::FunctionReference &funcRef) { // Emit message if the function reference fix will end up an array element - // reference with no subscripts because it will not be possible to later tell - // the difference in expressions between empty subscript list due to bad - // subscripts error recovery or because the user did not put any. - if (std::get>(funcRef.v.t).empty()) { - auto &proc{std::get(funcRef.v.t)}; - const auto *name{std::get_if(&proc.u)}; - if (!name) { - name = &std::get(proc.u).v.thing.component; - } - auto &msg{context.Say(funcRef.v.source, - name->symbol && name->symbol->Rank() == 0 - ? "'%s' is not a function"_err_en_US - : "Reference to array '%s' with empty subscript list"_err_en_US, - name->source)}; - if (name->symbol) { - if (semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)) { - msg.Attach(name->source, - "A result variable must be declared with RESULT to allow recursive " - "function calls"_en_US); - } else { + // reference with no subscripts, or subscripts on a scalar, because it will + // not be possible to later distinguish in expressions between an empty + // subscript list due to bad subscripts error recovery or because the + // user did not put any. + auto &proc{std::get(funcRef.v.t)}; + const auto *name{std::get_if(&proc.u)}; + if (!name) { + name = &std::get(proc.u).v.thing.component; + } + if (!name->symbol) { + return false; + } else if (name->symbol->Rank() == 0) { + if (const Symbol * + function{ + semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)}) { + auto &msg{context.Say(funcRef.v.source, + "Recursive call to '%s' requires a distinct RESULT in its declaration"_err_en_US, + name->source)}; + AttachDeclaration(&msg, *function); + name->symbol = const_cast(function); + } + return false; + } else { + if (std::get>(funcRef.v.t).empty()) { + auto &msg{context.Say(funcRef.v.source, + "Reference to array '%s' with empty subscript list"_err_en_US, + name->source)}; + if (name->symbol) { AttachDeclaration(&msg, *name->symbol); } } + return true; } } @@ -2841,8 +2851,9 @@ // pointer as per C1105 so this cannot be a function reference. if constexpr (common::HasMember, uType>) { - CheckFuncRefToArrayElementRefHasSubscripts(context, funcRef); - u = common::Indirection{funcRef.ConvertToArrayElementRef()}; + if (CheckFuncRefToArrayElement(context, funcRef)) { + u = common::Indirection{funcRef.ConvertToArrayElementRef()}; + } } else { DIE("can't fix misparsed function as array reference"); } Index: flang/lib/Semantics/tools.cpp =================================================================== --- flang/lib/Semantics/tools.cpp +++ flang/lib/Semantics/tools.cpp @@ -1345,13 +1345,15 @@ return nullptr; } -bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) { +const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) { if (IsFunctionResult(symbol)) { if (const Symbol * function{symbol.owner().symbol()}) { - return symbol.name() == function->name(); + if (symbol.name() == function->name()) { + return function; + } } } - return false; + return nullptr; } void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) { Index: flang/test/Semantics/resolve59.f90 =================================================================== --- flang/test/Semantics/resolve59.f90 +++ flang/test/Semantics/resolve59.f90 @@ -10,7 +10,7 @@ ! testing with data object results function f1() real :: x, f1 - !ERROR: 'f1' is not a function + !ERROR: Recursive call to 'f1' requires a distinct RESULT in its declaration x = acos(f1()) f1 = x x = acos(f1) !OK @@ -18,7 +18,7 @@ function f2(i) integer i real :: x, f2 - !ERROR: 'f2' is not an array + !ERROR: Recursive call to 'f2' requires a distinct RESULT in its declaration x = acos(f2(i+1)) f2 = x x = acos(f2) !OK @@ -63,7 +63,7 @@ end function function f7() result(f7) !OKI (warning) real :: x, f7 - !ERROR: 'f7' is not a function + !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration x = acos(f7()) f7 = x x = acos(f7) !OK @@ -124,7 +124,7 @@ ! testing that calling the result is also caught function f6() result(r) real :: x, r - !ERROR: 'r' is not a function + !ERROR: 'r' is not a callable procedure x = r() end function end module Index: flang/test/Semantics/resolve93.f90 =================================================================== --- flang/test/Semantics/resolve93.f90 +++ flang/test/Semantics/resolve93.f90 @@ -9,8 +9,9 @@ character(10) str3 !ERROR: Cannot reference function 'str1' as data print *, str1(1:9), str1(7) - !ERROR: 'str2' is not an array - print *, str2(1:9), str2(7) + print *, str2(1:9) ! substring is ok + !ERROR: 'str2' is not a callable procedure + print *, str2(7) !ERROR: Cannot reference function 'str3' as data print *, str3(7), str3(1:9) end block