[flang-commits] [flang] [flang] Don't set Subroutine flag on PROCEDURE() pointers (PR #102011)

[Peter Klausler via flang-commits]

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

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 https://github.com/llvm/llvm-project/issues/101908.

>From 708faad893aed0e37ca013acbf60305c155829ac Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 5 Aug 2024 09:26:36 -0700
Subject: [PATCH] [flang] Don't set Subroutine flag on PROCEDURE() pointers

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 https://github.com/llvm/llvm-project/issues/101908.
---
 flang/lib/Semantics/resolve-names.cpp |  2 +-
 flang/test/Semantics/assign03.f90     | 10 ++++++++++
 2 files changed, 11 insertions(+), 1 deletion(-)

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