[flang] Prevent RESULT name from being the same as the function.

Fix flang-compiler/f18#726.
Add test and error messsage for such scenario and set error on the
result symbol because it is unclear what it is inside the function.

Original-commit: flang-compiler/f18@a3d5b5af0d4a2537e2cd1cf84cae16e622d2c50c
Reviewed-on: https://github.com/flang-compiler/f18/pull/743
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 9a59c2f..314c327 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -2502,6 +2502,13 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   funcResultDetails.set_funcResult(true);
   funcInfo_.resultSymbol =
       &MakeSymbol(*funcResultName, std::move(funcResultDetails));
+  if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) {
+    // C1560. TODO also enforce on entry names when entry implemented
+    Say(funcInfo_.resultName->source,
+        "'%s' is already the function name and cannot appear in RESULT"_err_en_US,
+        name.source);
+    context().SetError(*funcInfo_.resultSymbol);
+  }
   details.set_result(*funcInfo_.resultSymbol);
   name.symbol = currScope().symbol();  // must not be function result symbol
 }

diff --git a/flang/test/semantics/resolve59.f90 b/flang/test/semantics/resolve59.f90
index 076ccbe..c067aae 100644 (file)
--- a/flang/test/semantics/resolve59.f90
+++ b/flang/test/semantics/resolve59.f90
@@ -76,6 +76,17 @@ end module
 module m_with_result
 ! With RESULT, it refers to the function (recursive calls possible)
 contains
+  ! Sanity test C1560
+  !ERROR: 'f00' is already the function name and cannot appear in RESULT
+  function f00() result(f00)
+  end function
+  !ERROR: 'f0' is already the function name and cannot appear in RESULT
+  function f0(i) result(f0)
+    integer :: i
+    complex(4) :: f0
+    f0 = f0(i+1)*2.
+  end function
+
   ! testing with data object results
   function f1() result(r)
     real :: r