aboutsummaryrefslogtreecommitdiff
path: root/flang
diff options
context:
space:
mode:
authorPeter Klausler <pklausler@nvidia.com>2023-07-18 09:32:33 -0700
committerPeter Klausler <pklausler@nvidia.com>2023-07-21 12:02:42 -0700
commitccd78958f696af7e2d3451c1291640cada4ef6ab (patch)
tree7f812b09425ac5f39806f3900c16143efd2cc26c /flang
parentf6026f65be7113953c72720182562c3d67d2312e (diff)
downloadllvm-ccd78958f696af7e2d3451c1291640cada4ef6ab.zip
llvm-ccd78958f696af7e2d3451c1291640cada4ef6ab.tar.gz
llvm-ccd78958f696af7e2d3451c1291640cada4ef6ab.tar.bz2
[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
Diffstat (limited to 'flang')
-rw-r--r--flang/lib/Semantics/resolve-names.cpp12
-rw-r--r--flang/test/Semantics/assign09.f904
2 files changed, 15 insertions, 1 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3afba79..8530810 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 d3c72f3..b29e67a 100644
--- a/flang/test/Semantics/assign09.f90
+++ b/flang/test/Semantics/assign09.f90
@@ -41,6 +41,10 @@ program test
!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