diff --git a/flang/lib/Parser/parse-tree.cpp b/flang/lib/Parser/parse-tree.cpp index 4edb3c67ba92..38f08f139f3a 100644 --- a/flang/lib/Parser/parse-tree.cpp +++ b/flang/lib/Parser/parse-tree.cpp @@ -203,28 +203,33 @@ Substring ArrayElement::ConvertToSubstring() { } // R1544 stmt-function-stmt -// Convert this stmt-function-stmt to an array element assignment statement. +// Convert this stmt-function-stmt to an assignment to the result of a +// pointer-valued function call -- which itself will be converted to a +// much more likely array element assignment statement if it needs +// to be. Statement StmtFunctionStmt::ConvertToAssignment() { auto &funcName{std::get(t)}; auto &funcArgs{std::get>(t)}; auto &funcExpr{std::get>(t).thing}; CharBlock source{funcName.source}; - std::list subscripts; - for (Name &arg : funcArgs) { - subscripts.push_back(WithSource(arg.source, - Expr{common::Indirection{ - WithSource(arg.source, Designator{DataRef{Name{arg}}})}})); - source.ExtendToCover(arg.source); - } - // extend source to include closing paren + // Extend source to include closing parenthesis if (funcArgs.empty()) { CHECK(*source.end() == '('); source = CharBlock{source.begin(), source.end() + 1}; } + std::list actuals; + for (const Name &arg : funcArgs) { + actuals.emplace_back(std::optional{}, + ActualArg{Expr{WithSource( + arg.source, Designator{DataRef{Name{arg.source, arg.symbol}}})}}); + source.ExtendToCover(arg.source); + } CHECK(*source.end() == ')'); source = CharBlock{source.begin(), source.end() + 1}; - auto variable{Variable{common::Indirection{WithSource( - source, MakeArrayElementRef(funcName, std::move(subscripts)))}}}; + FunctionReference funcRef{WithSource(source, + Call{ProcedureDesignator{Name{funcName.source, funcName.symbol}}, + std::move(actuals)})}; + auto variable{Variable{common::Indirection{std::move(funcRef)}}}; return Statement{std::nullopt, ActionStmt{common::Indirection{ AssignmentStmt{std::move(variable), std::move(funcExpr)}}}}; diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp index 289a4e1d6e9b..1e0b9105dda8 100644 --- a/flang/lib/Semantics/rewrite-parse-tree.cpp +++ b/flang/lib/Semantics/rewrite-parse-tree.cpp @@ -21,7 +21,8 @@ namespace Fortran::semantics { using namespace parser::literals; -/// Convert misidentified statement functions to array element assignments. +/// Convert misidentified statement functions to array element assignments +/// or pointer-valued function result assignments. /// Convert misidentified format expressions to namelist group names. /// Convert misidentified character variables in I/O units to integer /// unit number expressions. @@ -82,16 +83,23 @@ void RewriteMutator::Post(parser::Name &name) { void RewriteMutator::Post(parser::SpecificationPart &x) { auto &list{std::get>(x.t)}; for (auto it{list.begin()}; it != list.end();) { - if (auto stmt{std::get_if(&it->u)}) { - Symbol *symbol{std::get(stmt->statement.value().t).symbol}; - if (symbol && symbol->has()) { - // not a stmt func: remove it here and add to ones to convert - stmtFuncsToConvert_.push_back(std::move(*stmt)); - it = list.erase(it); - continue; + bool isAssignment{false}; + if (auto *stmt{std::get_if(&it->u)}) { + if (const Symbol * + symbol{std::get(stmt->statement.value().t).symbol}) { + const Symbol *funcRes{FindFunctionResult(*symbol)}; + isAssignment = symbol->has() || + (funcRes && IsPointer(*funcRes) && !IsProcedure(*funcRes)); + if (isAssignment) { + stmtFuncsToConvert_.emplace_back(std::move(*stmt)); + } } } - ++it; + if (isAssignment) { + it = list.erase(it); + } else { + ++it; + } } }