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

[via flang-commits]

Author: Peter Klausler
Date: 2024-08-08T11:05:39-07:00
New Revision: d9af9cf436ad1b892ecf8b794b0052135cc4029c

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

LOG: [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.

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b7725c5b002284..2fe45f9c941d71 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 a80ef1e102b2b9..d8e7f14238f920 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