[flang-commits] [flang] [flang] Skim usage before marking unknown module externals as subrout… (PR #83897)

[Peter Klausler via flang-commits]

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

…ines

Name resolution needs to delay its default determination of module external procedures as subroutines until after it has skimmed the execution parts of module procedures.

Fixes https://github.com/llvm/llvm-project/issues/83622.

>From ac7b4f6d177005d47fb2bccd6211b6eb9f5cfd77 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 4 Mar 2024 11:27:15 -0800
Subject: [PATCH] [flang] Skim usage before marking unknown module externals as
 subroutines

Name resolution needs to delay its default determination of module
external procedures as subroutines until after it has skimmed the
execution parts of module procedures.

Fixes https://github.com/llvm/llvm-project/issues/83622.
---
 flang/lib/Semantics/resolve-names.cpp | 20 ++++++------
 flang/test/Semantics/resolve09.f90    | 44 +++++++++++++++++++++------
 2 files changed, 45 insertions(+), 19 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5a95d3a98992a7..26cae833edfcff 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8447,7 +8447,6 @@ void ResolveNamesVisitor::FinishSpecificationPart(
   misparsedStmtFuncFound_ = false;
   funcResultStack().CompleteFunctionResultType();
   CheckImports();
-  bool inModule{currScope().kind() == Scope::Kind::Module};
   for (auto &pair : currScope()) {
     auto &symbol{*pair.second};
     if (NeedsExplicitType(symbol)) {
@@ -8462,13 +8461,6 @@ void ResolveNamesVisitor::FinishSpecificationPart(
     if (symbol.has<GenericDetails>()) {
       CheckGenericProcedures(symbol);
     }
-    if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
-        !symbol.test(Symbol::Flag::Function) &&
-        !symbol.test(Symbol::Flag::Subroutine)) {
-      // in a module, external proc without return type is subroutine
-      symbol.set(
-          symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
-    }
     if (!symbol.has<HostAssocDetails>()) {
       CheckPossibleBadForwardRef(symbol);
     }
@@ -8990,8 +8982,18 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
   }
   EndScopeForNode(node);
   // Ensure that every object entity has a type.
+  bool inModule{node.GetKind() == ProgramTree::Kind::Module ||
+      node.GetKind() == ProgramTree::Kind::Submodule};
   for (auto &pair : *node.scope()) {
-    ApplyImplicitRules(*pair.second);
+    Symbol &symbol{*pair.second};
+    if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
+        !symbol.test(Symbol::Flag::Function) &&
+        !symbol.test(Symbol::Flag::Subroutine)) {
+      // in a module, external proc without return type is subroutine
+      symbol.set(
+          symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
+    }
+    ApplyImplicitRules(symbol);
   }
 }
 
diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index c5e4277b3b6114..634b9861f3b67f 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -52,25 +52,49 @@ subroutine s3b()
   end
 end
 
-module m
-  ! subroutine vs. function is determined at end of specification part
-  external :: a
-  procedure() :: b
+module m1
+  !Function vs subroutine in a module is resolved to a subroutine if
+  !no other information.
+  external :: exts, extf, extunk
+  procedure() :: procs, procf, procunk
 contains
-  subroutine s()
-    call a()
-    !ERROR: Cannot call subroutine 'b' like a function
-    x = b()
+  subroutine s
+    call exts()
+    call procs()
+    x = extf()
+    x = procf()
   end
 end
 
+module m2
+  use m1
+ contains
+  subroutine test
+    call exts() ! ok
+    call procs() ! ok
+    call extunk() ! ok
+    call procunk() ! ok
+    x = extf() ! ok
+    x = procf() ! ok
+    !ERROR: Cannot call subroutine 'extunk' like a function
+    !ERROR: Function result characteristics are not known
+    x = extunk()
+    !ERROR: Cannot call subroutine 'procunk' like a function
+    !ERROR: Function result characteristics are not known
+    x = procunk()
+  end
+end
+
+module modulename
+end
+
 ! Call to entity in global scope, even with IMPORT, NONE
 subroutine s4
   block
     import, none
     integer :: i
-    !ERROR: 'm' is not a callable procedure
-    call m()
+    !ERROR: 'modulename' is not a callable procedure
+    call modulename()
   end block
 end