[flang-commits] [flang] [flang] Catch name resolution error due to global scoping (PR #77683)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/77683

In
    CALL FOO
    PRINT *, ABS(FOO)
we currently resolve the first FOO to a global external subprogram, but then the second FOO is treated as an implicitly typed local variable.  This happens because the name FOO is not present in the local scope.

Fix by adding FOO to the local scope using a place-holding HostAssocDetails symbol whose existence prevents the creation of another FOO in the local scope.  The symbol stored in the parser::Name parse tree nodes or used in typed expressions will all continue to point to the global external subprogram.

Resolves llvm-test-suite/Fortran/gfortran/regression/pr71859.f90.

>From d3cdfe5628cf5907bdde1a334ccd7841b919501a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 10 Jan 2024 12:13:31 -0800
Subject: [PATCH] [flang] Catch name resolution error due to global scoping

In
    CALL FOO
    PRINT *, ABS(FOO)
we currently resolve the first FOO to a global external subprogram,
but then the second FOO is treated as an implicitly typed local
variable.  This happens because the name FOO is not present in the
local scope.

Fix by adding FOO to the local scope using a place-holding
HostAssocDetails symbol whose existence prevents the creation of
another FOO in the local scope.  The symbol stored in the parser::Name
parse tree nodes or used in typed expressions will all continue to
point to the global external subprogram.

Resolves llvm-test-suite/Fortran/gfortran/regression/pr71859.f90.
---
 flang/lib/Semantics/resolve-names.cpp | 12 +++++++++++-
 flang/test/Semantics/entry01.f90      |  1 -
 flang/test/Semantics/reshape.f90      |  1 -
 flang/test/Semantics/resolve09.f90    | 10 +++++++---
 4 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 64fc7de120873a..5da7e95d19a171 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7756,6 +7756,11 @@ void ResolveNamesVisitor::HandleProcedureName(
     if (!symbol->attrs().test(Attr::INTRINSIC)) {
       if (CheckImplicitNoneExternal(name.source, *symbol)) {
         MakeExternal(*symbol);
+        // Create a place-holder HostAssocDetails symbol to preclude later
+        // use of this name as a local symbol; but don't actually use this new
+        // HostAssocDetails symbol in expressions.
+        MakeHostAssocSymbol(name, *symbol);
+        name.symbol = symbol;
       }
     }
     CheckEntryDummyUse(name.source, symbol);
@@ -7763,7 +7768,12 @@ void ResolveNamesVisitor::HandleProcedureName(
   } else if (CheckUseError(name)) {
     // error was reported
   } else {
-    symbol = &Resolve(name, symbol)->GetUltimate();
+    symbol = &symbol->GetUltimate();
+    if (symbol->has<SubprogramDetails>() && symbol->owner().IsGlobal() &&
+        (!name.symbol || name.symbol->has<HostAssocDetails>())) {
+      // Replace place-holder HostAssocDetails created above on earlier call
+      name.symbol = symbol;
+    }
     CheckEntryDummyUse(name.source, symbol);
     bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
     if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
diff --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90
index 64bd954f8ae0fe..f1e16fc86a566f 100644
--- a/flang/test/Semantics/entry01.f90
+++ b/flang/test/Semantics/entry01.f90
@@ -137,7 +137,6 @@ subroutine externals
   entry iok1
   integer :: ix
   !ERROR: Cannot call subroutine 'iproc' like a function
-  !ERROR: Function result characteristics are not known
   ix = iproc()
   entry iproc
 end subroutine
diff --git a/flang/test/Semantics/reshape.f90 b/flang/test/Semantics/reshape.f90
index ea302ceed66aad..a35f38b32654aa 100644
--- a/flang/test/Semantics/reshape.f90
+++ b/flang/test/Semantics/reshape.f90
@@ -56,7 +56,6 @@ program reshaper
   !ERROR: Size of 'shape=' argument must not be greater than 15
   CALL ext_sub(RESHAPE([(n, n=1,20)], &
     [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]))
-  !WARNING: Reference to the procedure 'ext_sub' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes
   !ERROR: 'shape=' argument must not have a negative extent
   CALL ext_sub(RESHAPE([(n, n=1,20)], [1, -5, 3]))
   !ERROR: 'order=' argument has unacceptable rank 2
diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index 6335de1e232749..8e3b3bc2552d28 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -11,6 +11,7 @@
 call y
 call x
 !ERROR: Cannot call subroutine 'x' like a function
+!ERROR: Function result characteristics are not known
 z = x()
 end
 
@@ -18,7 +19,6 @@ subroutine s
   !ERROR: Cannot call function 'f' like a subroutine
   call f
   !ERROR: Cannot call subroutine 's' like a function
-  !ERROR: Function result characteristics are not known
   i = s()
 contains
   function f()
@@ -71,8 +71,6 @@ subroutine s4
     import, none
     integer :: i
     !ERROR: 'm' is not a callable procedure
-    i = m()
-    !ERROR: 'm' is not a callable procedure
     call m()
   end block
 end
@@ -126,3 +124,9 @@ subroutine s9
   !ERROR: Cannot call subroutine 'p2' like a function
   print *, x%p2()
 end subroutine
+
+subroutine s10
+  call a10
+  !ERROR: Actual argument for 'a=' may not be a procedure
+  print *, abs(a10)
+end