From d9af9cf436ad1b892ecf8b794b0052135cc4029c Mon Sep 17 00:00:00 2001
From: Peter Klausler <35819229+klausler@users.noreply.github.com>
Date: Thu, 8 Aug 2024 11:05:39 -0700
Subject: [PATCH] [flang] Don't set Subroutine flag on PROCEDURE() pointers
 (#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.
---
 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 b7725c5b0022..2fe45f9c941d 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 a80ef1e102b2..d8e7f14238f9 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 @@ contains
     !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