[flang-commits] [flang] [flang] Improve handling of NULL() arguments to intrinsics (PR #93866)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Jun 3 14:13:38 PDT 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/93866
>From f173a091c5f93b10dc8de41f1096933692bae88a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 30 May 2024 11:49:25 -0700
Subject: [PATCH] [flang] Improve handling of NULL() arguments to intrinsics
Some intrinsics (extends_type_of, same_type_as) can accept a NULL
actual argument so long as it has a MOLD=. Some intrinsics that
are marked in the intrinsics table as accepting a NULL actual argument
already should only do so if it has a MOLD=. Distinguish table
entries that accept a NULL() only with a MOLD= from the few others
that allow a bare NULL() and update tests.
Fixes https://github.com/llvm/llvm-project/issues/93845.
---
flang/lib/Evaluate/intrinsics.cpp | 66 +++++++++++++++++-------------
flang/test/Semantics/null01.f90 | 13 ++++++
flang/test/Semantics/resolve09.f90 | 2 +-
3 files changed, 51 insertions(+), 30 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index b4153ffc40c6b..69771aaf97d7c 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -225,7 +225,8 @@ ENUM_CLASS(Optionality, required,
)
ENUM_CLASS(ArgFlag, none,
- canBeNull, // actual argument can be NULL()
+ canBeNull, // actual argument can be NULL(with or without MOLD=)
+ canBeMoldNull, // actual argument can be NULL(with MOLD=)
defaultsToSameKind, // for MatchingDefaultKIND
defaultsToSizeKind, // for SizeDefaultKIND
defaultsToDefaultForResult, // for DefaultingKIND
@@ -368,7 +369,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
DefaultLogical},
{"bit_size",
{{"i", SameInt, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"ble",
{{"i", AnyInt, Rank::elementalOrBOZ},
@@ -403,7 +404,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"dble", {{"a", AnyNumeric, Rank::elementalOrBOZ}}, DoublePrecision},
{"digits",
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"dim", {{"x", OperandIntOrReal}, {"y", OperandIntOrReal}},
OperandIntOrReal},
@@ -449,7 +450,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
IntrinsicClass::transformationalFunction},
{"epsilon",
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"erf", {{"x", SameReal}}, SameReal},
{"erfc", {{"x", SameReal}}, SameReal},
@@ -463,8 +464,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"exponent", {{"x", AnyReal}}, DefaultInt},
{"exp", {{"x", SameFloating}}, SameFloating},
{"extends_type_of",
- {{"a", ExtensibleDerived, Rank::anyOrAssumedRank},
- {"mold", ExtensibleDerived, Rank::anyOrAssumedRank}},
+ {{"a", ExtensibleDerived, Rank::anyOrAssumedRank, Optionality::required,
+ common::Intent::In, {ArgFlag::canBeMoldNull}},
+ {"mold", ExtensibleDerived, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
DefaultLogical, Rank::scalar, IntrinsicClass::inquiryFunction},
{"failed_images", {OptionalTEAM, SizeDefaultKIND}, KINDInt, Rank::vector,
IntrinsicClass::transformationalFunction},
@@ -512,7 +516,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getpid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameIntOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
@@ -574,7 +578,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"jzext", {{"i", AnyInt}}, DefaultInt},
{"kind",
{{"x", AnyIntrinsic, Rank::elemental, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::elemental, IntrinsicClass::inquiryFunction},
{"lbound",
{{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
@@ -588,7 +592,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"leadz", {{"i", AnyInt}}, DefaultInt},
{"len",
{{"string", AnyChar, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}},
DefaultingKIND},
KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"len_trim", {{"string", AnyChar}, DefaultingKIND}, KINDInt},
@@ -642,7 +646,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameCharNoLen},
{"maxexponent",
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"maxloc",
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -681,7 +685,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameCharNoLen},
{"minexponent",
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"minloc",
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -707,7 +711,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
{"new_line",
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameCharNoLen, Rank::scalar, IntrinsicClass::inquiryFunction},
{"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
{"norm2", {{"x", SameReal, Rank::array}, RequiredDIM}, SameReal,
@@ -747,21 +751,21 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
{"precision",
{{"x", AnyFloating, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"present", {{"a", Addressable, Rank::anyOrAssumedRank}}, DefaultLogical,
Rank::scalar, IntrinsicClass::inquiryFunction},
{"radix",
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"range",
{{"x", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"rank",
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"real", {{"a", SameComplex, Rank::elemental}},
SameReal}, // 16.9.160(4)(ii)
@@ -792,8 +796,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameType, Rank::shaped, IntrinsicClass::transformationalFunction},
{"rrspacing", {{"x", SameReal}}, SameReal},
{"same_type_as",
- {{"a", ExtensibleDerived, Rank::anyOrAssumedRank},
- {"b", ExtensibleDerived, Rank::anyOrAssumedRank}},
+ {{"a", ExtensibleDerived, Rank::anyOrAssumedRank, Optionality::required,
+ common::Intent::In, {ArgFlag::canBeMoldNull}},
+ {"b", ExtensibleDerived, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
DefaultLogical, Rank::scalar, IntrinsicClass::inquiryFunction},
{"scale", {{"x", SameReal}, {"i", AnyInt}}, SameReal}, // == IEEE_SCALB()
{"scan",
@@ -851,7 +858,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
IntrinsicClass::transformationalFunction},
{"storage_size",
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}},
SizeDefaultKIND},
KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"sum", {{"array", SameNumeric, Rank::array}, RequiredDIM, OptionalMASK},
@@ -873,7 +880,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
IntrinsicClass::transformationalFunction},
{"tiny",
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeNull}}},
+ common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"trailz", {{"i", AnyInt}}, DefaultInt},
{"transfer",
@@ -1744,9 +1751,11 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
return std::nullopt;
}
if (!d.flags.test(ArgFlag::canBeNull)) {
- // NULL() is rarely an acceptable intrinsic argument.
- if (const auto *expr{arg->UnwrapExpr()}) {
- if (IsNullPointer(*expr)) {
+ if (const auto *expr{arg->UnwrapExpr()}; expr && IsNullPointer(*expr)) {
+ if (!IsBareNullPointer(expr) && IsNullObjectPointer(*expr) &&
+ d.flags.test(ArgFlag::canBeMoldNull)) {
+ // ok
+ } else {
messages.Say(arg->sourceLocation(),
"A NULL() pointer is not allowed for '%s=' intrinsic argument"_err_en_US,
d.keyword);
@@ -1801,19 +1810,18 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
}
}
} else {
- // NULL(), procedure, or procedure pointer
+ // NULL(no MOLD=), procedure, or procedure pointer
CHECK(IsProcedurePointerTarget(expr));
if (d.typePattern.kindCode == KindCode::addressable ||
d.rank == Rank::reduceOperation) {
continue;
} else if (d.typePattern.kindCode == KindCode::nullPointerType) {
continue;
- } else if (IsNullPointer(expr)) {
- messages.Say(arg->sourceLocation(),
- "Actual argument for '%s=' may not be NULL()"_err_en_US,
- d.keyword);
+ } else if (IsBareNullPointer(&expr)) {
+ // checked elsewhere
+ continue;
} else {
- CHECK(IsProcedure(expr));
+ CHECK(IsProcedure(expr) || IsProcedurePointer(expr));
messages.Say(arg->sourceLocation(),
"Actual argument for '%s=' may not be a procedure"_err_en_US,
d.keyword);
diff --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90
index b61d464d0e7ce..3bf620048e2f2 100644
--- a/flang/test/Semantics/null01.f90
+++ b/flang/test/Semantics/null01.f90
@@ -49,6 +49,8 @@ function f3()
type :: dt4
real, allocatable :: ra0
end type dt4
+ type, extends(dt4) :: dt5
+ end type dt5
integer :: j
type(dt0) :: dt0x
type(dt1) :: dt1x
@@ -64,6 +66,8 @@ function f3()
integer, parameter :: eight = ip0r + ip1r + ip2r + 5
real(kind=eight) :: r8check
logical, pointer :: lp
+ type(dt4), pointer :: dt4p
+ type(dt5), pointer :: dt5p
ip0 => null() ! ok
ip0 => null(null()) ! ok
ip0 => null(null(null())) ! ok
@@ -115,6 +119,15 @@ function f3()
call implicit(null(mold=ip0))
!ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
print *, sin(null(rp0))
+ !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
+ print *, kind(null())
+ print *, kind(null(rp0)) ! ok
+ !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument
+ print *, extends_type_of(null(), null())
+ print *, extends_type_of(null(dt5p), null(dt4p)) ! ok
+ !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument
+ print *, same_type_as(null(), null())
+ print *, same_type_as(null(dt5p), null(dt4p)) ! ok
!ERROR: A NULL() pointer is not allowed for 'source=' intrinsic argument
print *, transfer(null(rp0),ip0)
!WARNING: Source of TRANSFER contains allocatable or pointer component %ra0
diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index 485526a733e4b..2fe21aebf66bd 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -156,7 +156,7 @@ subroutine s10
subroutine s11
real, pointer :: p(:)
- !ERROR: Actual argument for 'a=' may not be NULL()
+ !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument
print *, rank(null())
print *, rank(null(mold=p)) ! ok
end
More information about the flang-commits
mailing list