Skip to content

[flang] Improve handling of NULL() arguments to intrinsics #93866

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 3, 2024
Merged

[flang] Improve handling of NULL() arguments to intrinsics #93866

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 37 additions & 29 deletions flang/lib/Evaluate/intrinsics.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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},
Expand Down Expand Up @@ -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},
Expand Down Expand Up @@ -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},
Expand All @@ -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},
Expand Down Expand Up @@ -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},
Expand Down Expand Up @@ -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,
Expand All @@ -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},
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand All @@ -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,
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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},
Expand All @@ -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",
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down
13 changes: 13 additions & 0 deletions flang/test/Semantics/null01.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion flang/test/Semantics/resolve09.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading