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

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Thu Jan 11 13:51:30 PST 2024


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

>From 4e2ddb5e0f30d3f12aeaaab65ad6a98b6651cb52 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/resolve09.f90    |  9 ++++++---
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 64fc7de120873a..6b847e5796b486 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 (IsProcedure(*symbol) && 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/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index 6335de1e232749..c5e4277b3b6114 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -18,7 +18,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 +70,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 +123,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



More information about the flang-commits mailing list