[flang-commits] [flang] ccd7895 - [flang] Support implicit global external as procedure pointer target

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-21T12:02:42-07:00
New Revision: ccd78958f696af7e2d3451c1291640cada4ef6ab

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

LOG: [flang] Support implicit global external as procedure pointer target

A name that has been used to reference an undeclared global external
procedure should be accepted as the target of a procedure pointer
assignment statement.

Fixes llvm-test-suite/Fortran/gfortran/regression/proc_ptr_45.f90.

Differential Revision: https://reviews.llvm.org/D155963

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3afba79781a05f..853081007e85e6 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7519,8 +7519,9 @@ void ResolveNamesVisitor::HandleProcedureName(
                    currScope().context().GetPPCBuiltinsScope()) {
       // Check if it is a builtin from the predefined module
       symbol = FindSymbol(*ppcBuiltinScope, name);
-      if (!symbol)
+      if (!symbol) {
         symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
+      }
     } else {
       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     }
@@ -8030,6 +8031,15 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
       }
       return false;
     }
+    // Can also reference a global external procedure here
+    if (auto it{context().globalScope().find(name->source)};
+        it != context().globalScope().end()) {
+      Symbol &global{*it->second};
+      if (IsProcedure(global)) {
+        Resolve(*name, global);
+        return false;
+      }
+    }
   }
   Walk(expr);
   return false;

diff  --git a/flang/test/Semantics/assign09.f90 b/flang/test/Semantics/assign09.f90
index d3c72f355dd8ab..b29e67a473e130 100644
--- a/flang/test/Semantics/assign09.f90
+++ b/flang/test/Semantics/assign09.f90
@@ -41,6 +41,10 @@ elemental real function userElemental(a)
   !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
   call sub3(sqrt)
 
+  print *, implicitExtFunc()
+  call implicitExtSubr
+  noInterfaceProcPtr => implicitExtFunc ! ok
+  noInterfaceProcPtr => implicitExtSubr ! ok
   noInterfaceProcPtr => noInterfaceExternal ! ok
   realToRealProcPtr => noInterfaceExternal ! ok
   intToRealProcPtr => noInterfaceExternal !ok