[flang-commits] [flang] [flang] Extension: Allow POINTER, INTENT(IN) passed objects (PR #172175)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sat Dec 13 12:35:21 PST 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/172175
ISO Fortran now accepts a non-pointer actual argument to associate with a dummy argument with the POINTER attribute if it is also INTENT(IN), so long as the actual argument is a valid target for the pointer. But passed-object dummy arguments still have a blanket prohibition against being pointers in the ISO standard. Relax that constraint in the case of INTENT(IN) so that passed objects can also benefit from the feature.
Fixes https://github.com/llvm/llvm-project/issues/172157.
>From 0f266d737a6e638e3340828d11a9df6f79e9f26a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sat, 13 Dec 2025 12:28:41 -0800
Subject: [PATCH] [flang] Extension: Allow POINTER,INTENT(IN) passed objects
ISO Fortran now accepts a non-pointer actual argument to associate with
a dummy argument with the POINTER attribute if it is also INTENT(IN),
so long as the actual argument is a valid target for the pointer.
But passed-object dummy arguments still have a blanket prohibition
against being pointers in the ISO standard. Relax that constraint
in the case of INTENT(IN) so that passed objects can also benefit
from the feature.
Fixes https://github.com/llvm/llvm-project/issues/172157.
---
flang/docs/Extensions.md | 2 ++
.../include/flang/Support/Fortran-features.h | 2 +-
flang/lib/Semantics/check-declarations.cpp | 15 ++++++++--
flang/test/Semantics/bug172157.f90 | 29 +++++++++++++++++++
flang/test/Semantics/resolve52.f90 | 2 +-
5 files changed, 45 insertions(+), 5 deletions(-)
create mode 100644 flang/test/Semantics/bug172157.f90
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 593cd99147515..64b066e922297 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -459,6 +459,8 @@ end
with an optional compilation-time warning. When executed, it
is treated as an 'nX' positioning control descriptor that skips
over the same number of characters, without comparison.
+* A passed-object dummy argument is allowed to be a pointer so long
+ as it is `INTENT(IN)`.
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index c7d0b7fca1d59..ef5c1a84ba3d7 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -56,7 +56,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy,
InaccessibleDeferredOverride, CudaWarpMatchFunction, DoConcurrentOffload,
- TransferBOZ, Coarray)
+ TransferBOZ, Coarray, PointerPassObject)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 9a6b3ff3cdc2c..2d6e2099878f5 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2608,9 +2608,6 @@ void CheckHelper::CheckPassArg(
if (!passArg.has<ObjectEntityDetails>()) {
msg = "Passed-object dummy argument '%s' of procedure '%s'"
" must be a data object"_err_en_US;
- } else if (passArg.attrs().test(Attr::POINTER)) {
- msg = "Passed-object dummy argument '%s' of procedure '%s'"
- " may not have the POINTER attribute"_err_en_US;
} else if (passArg.attrs().test(Attr::ALLOCATABLE)) {
msg = "Passed-object dummy argument '%s' of procedure '%s'"
" may not have the ALLOCATABLE attribute"_err_en_US;
@@ -2620,6 +2617,18 @@ void CheckHelper::CheckPassArg(
} else if (passArg.Rank() > 0) {
msg = "Passed-object dummy argument '%s' of procedure '%s'"
" must be scalar"_err_en_US;
+ } else if (passArg.attrs().test(Attr::POINTER)) {
+ if (context_.IsEnabled(common::LanguageFeature::PointerPassObject) &&
+ IsIntentIn(passArg)) {
+ // Extension: allow a passed object to be an INTENT(IN) POINTER
+ Warn(common::LanguageFeature::PointerPassObject, name,
+ "Passed-object dummy argument '%s' of procedure '%s'"
+ " that is an INTENT(IN) POINTER is not standard"_port_en_US,
+ *passName, name);
+ } else {
+ msg = "Passed-object dummy argument '%s' of procedure '%s'"
+ " may not have the POINTER attribute unless INTENT(IN)"_err_en_US;
+ }
}
if (msg) {
messages_.Say(name, std::move(*msg), passName.value(), name);
diff --git a/flang/test/Semantics/bug172157.f90 b/flang/test/Semantics/bug172157.f90
new file mode 100644
index 0000000000000..760df5e8918e9
--- /dev/null
+++ b/flang/test/Semantics/bug172157.f90
@@ -0,0 +1,29 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+ type t
+ procedure(sub), pass, pointer :: goodpp => sub ! ok
+ !ERROR: Passed-object dummy argument 'that' of procedure 'badpp' may not have the POINTER attribute unless INTENT(IN)
+ procedure(sub), pass(that), pointer :: badpp => sub ! ok
+ contains
+ procedure :: goodtbp => sub
+ !ERROR: Passed-object dummy argument 'that' of procedure 'badtbp' may not have the POINTER attribute unless INTENT(IN)
+ procedure, pass(that) :: badtbp => sub
+ end type
+ contains
+ subroutine sub(this, that)
+ class(t), pointer, intent(in) :: this
+ class(t), pointer :: that
+ end
+end
+
+program test
+ use m
+ type(t) xnt
+ type(t), target :: xt
+ !ERROR: In assignment to object dummy argument 'this=', the target 'xnt' is not an object with POINTER or TARGET attributes
+ call xnt%goodpp(null())
+ !ERROR: In assignment to object dummy argument 'this=', the target 'xnt' is not an object with POINTER or TARGET attributes
+ call xnt%goodtbp(null())
+ call xt%goodpp(null()) ! ok
+ call xt%goodtbp(null()) ! ok
+end
diff --git a/flang/test/Semantics/resolve52.f90 b/flang/test/Semantics/resolve52.f90
index 9f89510652b2e..26d938fd093b2 100644
--- a/flang/test/Semantics/resolve52.f90
+++ b/flang/test/Semantics/resolve52.f90
@@ -59,7 +59,7 @@ subroutine test
module m4
type :: t
- !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute
+ !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute unless INTENT(IN)
procedure(s1), pointer :: a
!ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute
procedure(s2), pointer, pass(x) :: b
More information about the flang-commits
mailing list