[flang] Don't set Subroutine flag on PROCEDURE() pointers

[klausler]

External procedures about which no characteristics are known -- from EXTERNAL and PROCEDURE() statements of entities that are never called -- are marked as subroutines. This shouldn't be done for procedure pointers, however.

Fixes #101908.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

External procedures about which no characteristics are known -- from EXTERNAL and PROCEDURE() statements of entities that are never called -- are marked as subroutines. This shouldn't be done for procedure pointers, however.

Fixes #101908.

---

Full diff: https://github.com/llvm/llvm-project/pull/102011.diff

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-names.cpp (+1-1)
• (modified) flang/test/Semantics/assign03.f90 (+10)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b7725c5b00228..2fe45f9c941d7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9235,7 +9235,7 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
       node.GetKind() == ProgramTree::Kind::Submodule};
   for (auto &pair : *node.scope()) {
     Symbol &symbol{*pair.second};
-    if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
+    if (inModule && symbol.attrs().test(Attr::EXTERNAL) && !IsPointer(symbol) &&
         !symbol.test(Symbol::Flag::Function) &&
         !symbol.test(Symbol::Flag::Subroutine)) {
       // in a module, external proc without return type is subroutine
diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index a80ef1e102b2b..d8e7f14238f92 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -1,6 +1,10 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Pointer assignment constraints 10.2.2.2 (see also assign02.f90)
 
+module m0
+  procedure(),pointer,save :: p
+end
+
 module m
   interface
     subroutine s(i)
@@ -324,4 +328,10 @@ subroutine s14
     !ERROR: Statement function 'sf' may not be the target of a pointer assignment
     ptr => sf
   end subroutine
+
+  subroutine s15
+    use m0
+    intrinsic sin
+    p=>sin ! ok
+  end
 end

[psteinfeld]

All builds and tests correctly and looks good.