[flang-commits] [flang] 149d3e4 - [flang] Disambiguate F(X)=Y case where F is a function returning a pointer

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-04-25T09:25:09-07:00
New Revision: 149d3e4365325fdb9b79a4d0e3f88a2c84e0baaf

URL: https://github.com/llvm/llvm-project/commit/149d3e4365325fdb9b79a4d0e3f88a2c84e0baaf
DIFF: https://github.com/llvm/llvm-project/commit/149d3e4365325fdb9b79a4d0e3f88a2c84e0baaf.diff

LOG: [flang] Disambiguate F(X)=Y case where F is a function returning a pointer

F(X)=Y may be initially parsed as a statement function definition; an
existing pass will detect statement functions that should be rewritten
into assignment statemets with array element references as their
left-hand side variables.  However, F() may also be a reference to a
function that returns a data pointer, and f18 did not handle this
case correctly.

The right fix is to rewrite the parse tree for F(X)=Y into an assignment
to a function reference result.  The cases that are actually assignments
to array elements -- including all of the cases previously handled --
will have their left-hand sides converted to array element references
later by another existing rewriting step.

Differential Revision: https://reviews.llvm.org/D124299

Added: 
    

Modified: 
    flang/lib/Parser/parse-tree.cpp
    flang/lib/Semantics/rewrite-parse-tree.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Parser/parse-tree.cpp b/flang/lib/Parser/parse-tree.cpp
index 4edb3c67ba92b..38f08f139f3aa 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<ActionStmt> StmtFunctionStmt::ConvertToAssignment() {
   auto &funcName{std::get<Name>(t)};
   auto &funcArgs{std::get<std::list<Name>>(t)};
   auto &funcExpr{std::get<Scalar<Expr>>(t).thing};
   CharBlock source{funcName.source};
-  std::list<Expr> 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<ActualArgSpec> actuals;
+  for (const Name &arg : funcArgs) {
+    actuals.emplace_back(std::optional<Keyword>{},
+        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 289a4e1d6e9ba..1e0b9105dda8f 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<std::list<parser::DeclarationConstruct>>(x.t)};
   for (auto it{list.begin()}; it != list.end();) {
-    if (auto stmt{std::get_if<stmtFuncType>(&it->u)}) {
-      Symbol *symbol{std::get<parser::Name>(stmt->statement.value().t).symbol};
-      if (symbol && symbol->has<ObjectEntityDetails>()) {
-        // 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<stmtFuncType>(&it->u)}) {
+      if (const Symbol *
+          symbol{std::get<parser::Name>(stmt->statement.value().t).symbol}) {
+        const Symbol *funcRes{FindFunctionResult(*symbol)};
+        isAssignment = symbol->has<ObjectEntityDetails>() ||
+            (funcRes && IsPointer(*funcRes) && !IsProcedure(*funcRes));
+        if (isAssignment) {
+          stmtFuncsToConvert_.emplace_back(std::move(*stmt));
+        }
       }
     }
-    ++it;
+    if (isAssignment) {
+      it = list.erase(it);
+    } else {
+      ++it;
+    }
   }
 }