[flang-commits] [flang] [flang] Relax ignore_tkr(c) for assumed-type BIND(C) descriptor dummies (PR #205445)
via flang-commits
flang-commits at lists.llvm.org
Tue Jun 23 15:48:55 PDT 2026
https://github.com/nvptm updated https://github.com/llvm/llvm-project/pull/205445
>From 59f5dc6492a39c7533093ee500842691ff367bd3 Mon Sep 17 00:00:00 2001
From: nvpm <pmathew at nvidia.com>
Date: Tue, 23 Jun 2026 15:19:42 -0700
Subject: [PATCH 1/2] [flang] Relax ignore_tkr(c) for assumed-type BIND(C)
descriptor dummies
---
flang/docs/Directives.md | 6 ++
flang/lib/Semantics/check-call.cpp | 51 ++++++++++-------
.../Semantics/call03-ignore-tkr-c-relaxed.f90 | 40 +++++++++++++
.../Semantics/call03-ignore-tkr-c-strict.f90 | 56 +++++++++++++++++++
4 files changed, 132 insertions(+), 21 deletions(-)
create mode 100644 flang/test/Semantics/call03-ignore-tkr-c-relaxed.f90
create mode 100644 flang/test/Semantics/call03-ignore-tkr-c-strict.f90
diff --git a/flang/docs/Directives.md b/flang/docs/Directives.md
index 385d44b7ced07..45080acb778e3 100644
--- a/flang/docs/Directives.md
+++ b/flang/docs/Directives.md
@@ -27,6 +27,12 @@ A list of non-standard directives supported by Flang
When the dummy argument is not passed by descriptor (e.g., an assumed-size
array in a BIND(C) interface), the base address is extracted from the actual
argument's descriptor and passed as a raw pointer.
+ When the dummy argument is assumed-type (`TYPE(*)`) and passed by descriptor
+ to a `BIND(C)` procedure, (C) also disables the F2023 15.5.2.5 p2 checks
+ that would otherwise reject actual arguments whose derived type has type
+ parameters, type-bound procedures, or final procedures; this is intended for
+ `BIND(C)` interfaces where the implementation treats the argument as an opaque
+ CFI descriptor at the call site.
The letter (P) ignores pointer and allocatable matching, so that one can pass
an allocatable array to routine with pointer array argument and vice versa.
The letter (M) disables matching of the actual argument's CUDA storage
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 97bb346cc72bb..ff670951f5a9a 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -517,27 +517,36 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::VOLATILE)};
if (actualDerived && !actualDerived->IsVectorType()) {
if (dummy.type.type().IsAssumedType()) {
- if (!actualDerived->parameters().empty()) { // 15.5.2.4(2)
- messages.Say(
- "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
- dummyName);
- }
- if (const Symbol *
- tbp{FindImmediateComponent(*actualDerived, [](const Symbol &symbol) {
- return symbol.has<ProcBindingDetails>();
- })}) { // 15.5.2.4(2)
- evaluate::SayWithDeclaration(messages, *tbp,
- "Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
- dummyName, tbp->name());
- }
- auto finals{FinalsForDerivedTypeInstantiation(*actualDerived)};
- if (!finals.empty()) { // 15.5.2.4(2)
- SourceName name{finals.front()->name()};
- if (auto *msg{messages.Say(
- "Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
- dummyName, actualDerived->typeSymbol().name(), name)}) {
- msg->Attach(name, "FINAL subroutine '%s' in derived type '%s'"_en_US,
- name, actualDerived->typeSymbol().name());
+ // Assumed-type dummies with ignore_tkr(c) passed via descriptor to
+ // bind(C) procedures model opaque CFI argument passing; the callee does
+ // not access derived-type structure as TYPE(*).
+ const bool relaxAssumedTypeDerivedChecks{
+ procedure.IsBindC() &&
+ dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous) &&
+ dummy.IsPassedByDescriptor(/*isBindC=*/true)};
+ if (!relaxAssumedTypeDerivedChecks) {
+ if (!actualDerived->parameters().empty()) { // F2023 15.5.2.5 p2
+ messages.Say(
+ "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
+ dummyName);
+ }
+ if (const Symbol *
+ tbp{FindImmediateComponent(*actualDerived, [](const Symbol &symbol) {
+ return symbol.has<ProcBindingDetails>();
+ })}) { // F2023 15.5.2.5 p2
+ evaluate::SayWithDeclaration(messages, *tbp,
+ "Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
+ dummyName, tbp->name());
+ }
+ auto finals{FinalsForDerivedTypeInstantiation(*actualDerived)};
+ if (!finals.empty()) { // F2023 15.5.2.5 p2
+ SourceName name{finals.front()->name()};
+ if (auto *msg{messages.Say(
+ "Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
+ dummyName, actualDerived->typeSymbol().name(), name)}) {
+ msg->Attach(name, "FINAL subroutine '%s' in derived type '%s'"_en_US,
+ name, actualDerived->typeSymbol().name());
+ }
}
}
}
diff --git a/flang/test/Semantics/call03-ignore-tkr-c-relaxed.f90 b/flang/test/Semantics/call03-ignore-tkr-c-relaxed.f90
new file mode 100644
index 0000000000000..922f97118e550
--- /dev/null
+++ b/flang/test/Semantics/call03-ignore-tkr-c-relaxed.f90
@@ -0,0 +1,40 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+! Test that ignore_tkr(c) on an assumed-type bind(C) descriptor dummy
+! relaxes F2023 15.5.2.5 p2 restrictions for opaque CFI argument passing.
+
+module m
+ type :: tbp
+ contains
+ procedure :: binding => subr
+ end type
+ type :: pdt(n)
+ integer, len :: n
+ end type
+ type :: final_typ
+ contains
+ final :: cleanup
+ end type
+
+ contains
+
+ subroutine subr(this)
+ class(tbp), intent(in) :: this
+ end subroutine
+ subroutine cleanup(this)
+ type(final_typ), intent(inout) :: this
+ end subroutine
+ subroutine cfi(x) bind(c)
+ type(*), dimension(..) :: x
+!dir$ ignore_tkr(c) x
+ end subroutine
+end module
+
+program main
+ use m
+ type(tbp) :: x
+ type(pdt(1)) :: y
+ type(final_typ) :: z
+ call cfi(x)
+ call cfi(y)
+ call cfi(z)
+end program
diff --git a/flang/test/Semantics/call03-ignore-tkr-c-strict.f90 b/flang/test/Semantics/call03-ignore-tkr-c-strict.f90
new file mode 100644
index 0000000000000..3e379d82996e1
--- /dev/null
+++ b/flang/test/Semantics/call03-ignore-tkr-c-strict.f90
@@ -0,0 +1,56 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Assumed-type dummies must enforce F2023 15.5.2.5 p2 for derived types with
+! PDT, TBP, or FINAL unless bind(C), ignore_tkr(c), and descriptor passing
+! all apply.
+
+module m
+ type :: tbp
+ contains
+ procedure :: binding => subr
+ end type
+ type :: pdt(n)
+ integer, len :: n
+ end type
+ type :: final_typ
+ contains
+ final :: cleanup
+ end type
+
+ contains
+
+ subroutine subr(this)
+ class(tbp), intent(in) :: this
+ end subroutine
+ subroutine cleanup(this)
+ type(final_typ), intent(inout) :: this
+ end subroutine
+ subroutine cfi(x) bind(c)
+ type(*), dimension(..) :: x
+ end subroutine
+ subroutine not_cfi(x)
+ type(*), dimension(..) :: x
+!dir$ ignore_tkr(c) x
+ end subroutine
+ subroutine not_descriptor(x) bind(c)
+ type(*) :: x(*)
+!dir$ ignore_tkr(c) x
+ end subroutine
+end module
+
+program main
+ use m
+ type(tbp) :: x
+ type(tbp), dimension(1) :: arr
+ type(pdt(1)) :: y
+ type(final_typ) :: z
+ !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
+ call cfi(x)
+ !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
+ call cfi(y)
+ !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final_typ' with FINAL subroutine 'cleanup'
+ call cfi(z)
+ !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
+ call not_cfi(x)
+ !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
+ call not_descriptor(arr)
+end program
>From e9ec4a5f1a1f254f643b2f657ff4aed405716e99 Mon Sep 17 00:00:00 2001
From: nvpm <pmathew at nvidia.com>
Date: Tue, 23 Jun 2026 15:48:24 -0700
Subject: [PATCH 2/2] Format
---
flang/lib/Semantics/check-call.cpp | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ff670951f5a9a..f91b9b1d0b67d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -520,8 +520,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// Assumed-type dummies with ignore_tkr(c) passed via descriptor to
// bind(C) procedures model opaque CFI argument passing; the callee does
// not access derived-type structure as TYPE(*).
- const bool relaxAssumedTypeDerivedChecks{
- procedure.IsBindC() &&
+ const bool relaxAssumedTypeDerivedChecks{procedure.IsBindC() &&
dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous) &&
dummy.IsPassedByDescriptor(/*isBindC=*/true)};
if (!relaxAssumedTypeDerivedChecks) {
@@ -530,10 +529,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
"Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
dummyName);
}
- if (const Symbol *
- tbp{FindImmediateComponent(*actualDerived, [](const Symbol &symbol) {
- return symbol.has<ProcBindingDetails>();
- })}) { // F2023 15.5.2.5 p2
+ if (const Symbol *tbp{FindImmediateComponent(
+ *actualDerived, [](const Symbol &symbol) {
+ return symbol.has<ProcBindingDetails>();
+ })}) { // F2023 15.5.2.5 p2
evaluate::SayWithDeclaration(messages, *tbp,
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
dummyName, tbp->name());
@@ -544,8 +543,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
dummyName, actualDerived->typeSymbol().name(), name)}) {
- msg->Attach(name, "FINAL subroutine '%s' in derived type '%s'"_en_US,
- name, actualDerived->typeSymbol().name());
+ msg->Attach(name,
+ "FINAL subroutine '%s' in derived type '%s'"_en_US, name,
+ actualDerived->typeSymbol().name());
}
}
}
More information about the flang-commits
mailing list