[flang-commits] [flang] 874fc53 - [flang] Catch inconsistent function/subroutine usage of procedure pointer components
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sat Oct 29 16:41:07 PDT 2022
Author: Peter Klausler
Date: 2022-10-29T16:08:07-07:00
New Revision: 874fc5339e7c59fa624ef7bf492ac53bb4f8962b
URL: https://github.com/llvm/llvm-project/commit/874fc5339e7c59fa624ef7bf492ac53bb4f8962b
DIFF: https://github.com/llvm/llvm-project/commit/874fc5339e7c59fa624ef7bf492ac53bb4f8962b.diff
LOG: [flang] Catch inconsistent function/subroutine usage of procedure pointer components
When a derived type has a procedure pointer component with no interface,
we can't do a lot of checking on its call sites, but we can at least require
that the same procedure pointer component be used consistently as either
a function or as a subroutine, but not both.
Differential Revision: https://reviews.llvm.org/D136905
Added:
Modified:
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve09.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7cbe27156895..6b68074b798d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6951,7 +6951,15 @@ void ResolveNamesVisitor::HandleCall(
common::visit(
common::visitors{
[&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
- [&](const parser::ProcComponentRef &x) { Walk(x); },
+ [&](const parser::ProcComponentRef &x) {
+ Walk(x);
+ const parser::Name &name{x.v.thing.component};
+ if (Symbol * symbol{name.symbol}) {
+ if (IsProcedure(*symbol)) {
+ SetProcFlag(name, *symbol, procFlag);
+ }
+ }
+ },
},
std::get<parser::ProcedureDesignator>(call.t).u);
Walk(std::get<std::list<parser::ActualArgSpec>>(call.t));
diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index 2954b146374d..6335de1e2327 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -113,3 +113,16 @@ subroutine a8()
function b8()
b8 = 0.0
end
+
+subroutine s9
+ type t
+ procedure(), nopass, pointer :: p1, p2
+ end type
+ type(t) x
+ print *, x%p1()
+ call x%p2
+ !ERROR: Cannot call function 'p1' like a subroutine
+ call x%p1
+ !ERROR: Cannot call subroutine 'p2' like a function
+ print *, x%p2()
+end subroutine
More information about the flang-commits
mailing list