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

[via flang-commits]

Author: Peter Klausler
Date: 2024-03-05T11:41:12-08:00
New Revision: 13cd0a905beab77fc31e08282c466246aae7eda6

URL: https://github.com/llvm/llvm-project/commit/13cd0a905beab77fc31e08282c466246aae7eda6
DIFF: https://github.com/llvm/llvm-project/commit/13cd0a905beab77fc31e08282c466246aae7eda6.diff

LOG: [flang] Skim usage before marking unknown module externals as subrout… (#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.

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve09.f90

Removed: 
    


################################################################################
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