Skip to content

Commit 79a25e1

Browse files
klauslerklausler
authored
[flang] Further work on NULL(MOLD=allocatable) (#129345)
Refine handling of NULL(...) in semantics to properly distinguish NULL(), NULL(objectPointer), NULL(procPointer), and NULL(allocatable) from each other in relevant contexts. Add IsNullAllocatable() and IsNullPointerOrAllocatable() utility functions. IsNullAllocatable() is true only for NULL(allocatable); it is false for a bare NULL(), which can be detected independently with IsBareNullPointer(). IsNullPointer() now returns false for NULL(allocatable). ALLOCATED(NULL(allocatable)) now works, and folds to .FALSE. These utilities were modified to accept const pointer arguments rather than const references; I usually prefer this style when the result should clearly be false for a null argument (in the C sense), and it helped me find all of their use sites in the code.
1 parent b2ba43a commit 79a25e1

20 files changed

+157
-105
lines changed

‎flang/include/flang/Evaluate/characteristics.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -349,8 +349,8 @@ struct FunctionResult {
349349

350350
// 15.3.1
351351
struct Procedure {
352-
ENUM_CLASS(
353-
Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer, Subroutine)
352+
ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer,
353+
NullAllocatable, Subroutine)
354354
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
355355
Procedure(){};
356356
Procedure(FunctionResult &&, DummyArguments &&, Attrs);

‎flang/include/flang/Evaluate/tools.h

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1059,9 +1059,11 @@ bool IsProcedurePointer(const Expr<SomeType> &);
10591059
bool IsProcedure(const Expr<SomeType> &);
10601060
bool IsProcedurePointerTarget(const Expr<SomeType> &);
10611061
bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
1062-
bool IsNullObjectPointer(const Expr<SomeType> &);
1063-
bool IsNullProcedurePointer(const Expr<SomeType> &);
1064-
bool IsNullPointer(const Expr<SomeType> &);
1062+
bool IsNullObjectPointer(const Expr<SomeType> *); // NULL() or NULL(objptr)
1063+
bool IsNullProcedurePointer(const Expr<SomeType> *); // NULL() or NULL(procptr)
1064+
bool IsNullPointer(const Expr<SomeType> *); // NULL() or NULL(pointer)
1065+
bool IsNullAllocatable(const Expr<SomeType> *); // NULL(allocatable)
1066+
bool IsNullPointerOrAllocatable(const Expr<SomeType> *); // NULL of any form
10651067
bool IsObjectPointer(const Expr<SomeType> &);
10661068

10671069
// Can Expr be passed as absent to an optional dummy argument.

‎flang/lib/Evaluate/check-expression.cpp

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -100,9 +100,9 @@ template <bool INVARIANT>
100100
bool IsConstantExprHelper<INVARIANT>::IsConstantStructureConstructorComponent(
101101
const Symbol &component, const Expr<SomeType> &expr) const {
102102
if (IsAllocatable(component)) {
103-
return IsNullObjectPointer(expr);
103+
return IsNullObjectPointer(&expr);
104104
} else if (IsPointer(component)) {
105-
return IsNullPointer(expr) || IsInitialDataTarget(expr) ||
105+
return IsNullPointerOrAllocatable(&expr) || IsInitialDataTarget(expr) ||
106106
IsInitialProcedureTarget(expr);
107107
} else {
108108
return (*this)(expr);
@@ -194,7 +194,7 @@ struct IsActuallyConstantHelper {
194194
const bool compIsConstant{(*this)(y)};
195195
// If an allocatable component is initialized by a constant,
196196
// the structure constructor is not a constant.
197-
if ((!compIsConstant && !IsNullPointer(y)) ||
197+
if ((!compIsConstant && !IsNullPointerOrAllocatable(&y)) ||
198198
(compIsConstant && IsAllocatable(sym))) {
199199
return false;
200200
}
@@ -311,7 +311,9 @@ class IsInitialDataTargetHelper
311311
bool operator()(const ProcedureRef &x) const {
312312
if (const SpecificIntrinsic * intrinsic{x.proc().GetSpecificIntrinsic()}) {
313313
return intrinsic->characteristics.value().attrs.test(
314-
characteristics::Procedure::Attr::NullPointer);
314+
characteristics::Procedure::Attr::NullPointer) ||
315+
intrinsic->characteristics.value().attrs.test(
316+
characteristics::Procedure::Attr::NullAllocatable);
315317
}
316318
return false;
317319
}
@@ -388,7 +390,7 @@ bool IsInitialProcedureTarget(const Expr<SomeType> &expr) {
388390
if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) {
389391
return IsInitialProcedureTarget(*proc);
390392
} else {
391-
return IsNullProcedurePointer(expr);
393+
return IsNullProcedurePointer(&expr);
392394
}
393395
}
394396

‎flang/lib/Evaluate/fold-logical.cpp

Lines changed: 7 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -652,21 +652,18 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
652652
if (name == "all") {
653653
return FoldAllAnyParity(
654654
context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
655+
} else if (name == "allocated") {
656+
if (IsNullAllocatable(args[0]->UnwrapExpr())) {
657+
return Expr<T>{false};
658+
}
655659
} else if (name == "any") {
656660
return FoldAllAnyParity(
657661
context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
658662
} else if (name == "associated") {
659-
bool gotConstant{true};
660-
const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()};
661-
if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) {
662-
gotConstant = false;
663-
} else if (args[1]) { // There's a second argument
664-
const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()};
665-
if (!secondArgExpr || !IsNullPointer(*secondArgExpr)) {
666-
gotConstant = false;
667-
}
663+
if (IsNullPointer(args[0]->UnwrapExpr()) ||
664+
(args[1] && IsNullPointer(args[1]->UnwrapExpr()))) {
665+
return Expr<T>{false};
668666
}
669-
return gotConstant ? Expr<T>{false} : Expr<T>{std::move(funcRef)};
670667
} else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
671668
static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
672669

‎flang/lib/Evaluate/fold.cpp

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ Expr<SomeDerived> FoldOperation(
7373
for (auto &&[symbol, value] : std::move(structure)) {
7474
auto expr{Fold(context, std::move(value.value()))};
7575
if (IsPointer(symbol)) {
76-
if (IsNullPointer(expr)) {
76+
if (IsNullPointer(&expr)) {
7777
// Handle x%c when x designates a named constant of derived
7878
// type and %c is NULL() in that constant.
7979
expr = Expr<SomeType>{NullPointer{}};
@@ -86,9 +86,10 @@ Expr<SomeDerived> FoldOperation(
8686
// F2023: 10.1.12 (3)(a)
8787
// If comp-spec is not null() for the allocatable component the
8888
// structure constructor is not a constant expression.
89-
isConstant &= IsNullPointer(expr);
89+
isConstant &= IsNullAllocatable(&expr) || IsBareNullPointer(&expr);
9090
} else {
91-
isConstant &= IsActuallyConstant(expr) || IsNullPointer(expr);
91+
isConstant &=
92+
IsActuallyConstant(expr) || IsNullPointerOrAllocatable(&expr);
9293
if (auto valueShape{GetConstantExtents(context, expr)}) {
9394
if (auto componentShape{GetConstantExtents(context, symbol)}) {
9495
if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {

‎flang/lib/Evaluate/intrinsics.cpp

Lines changed: 30 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -247,8 +247,10 @@ ENUM_CLASS(Optionality, required,
247247
)
248248

249249
ENUM_CLASS(ArgFlag, none,
250-
canBeNull, // actual argument can be NULL(with or without MOLD=)
251-
canBeMoldNull, // actual argument can be NULL(with MOLD=)
250+
canBeNullPointer, // actual argument can be NULL(with or without
251+
// MOLD=pointer)
252+
canBeMoldNull, // actual argument can be NULL(MOLD=any)
253+
canBeNullAllocatable, // actual argument can be NULL(MOLD=allocatable)
252254
defaultsToSameKind, // for MatchingDefaultKIND
253255
defaultsToSizeKind, // for SizeDefaultKIND
254256
defaultsToDefaultForResult, // for DefaultingKIND
@@ -343,8 +345,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
343345
Rank::dimReduced, IntrinsicClass::transformationalFunction},
344346
{"allocated", {{"scalar", AnyData, Rank::scalar}}, DefaultLogical,
345347
Rank::elemental, IntrinsicClass::inquiryFunction},
346-
{"allocated", {{"array", AnyData, Rank::anyOrAssumedRank}}, DefaultLogical,
347-
Rank::elemental, IntrinsicClass::inquiryFunction},
348+
{"allocated",
349+
{{"array", AnyData, Rank::anyOrAssumedRank, Optionality::required,
350+
common::Intent::In, {ArgFlag::canBeNullAllocatable}}},
351+
DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
348352
{"anint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
349353
{"any", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
350354
Rank::dimReduced, IntrinsicClass::transformationalFunction},
@@ -353,10 +357,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
353357
{"asinh", {{"x", SameFloating}}, SameFloating},
354358
{"associated",
355359
{{"pointer", AnyPointer, Rank::anyOrAssumedRank, Optionality::required,
356-
common::Intent::In, {ArgFlag::canBeNull}},
360+
common::Intent::In, {ArgFlag::canBeNullPointer}},
357361
{"target", Addressable, Rank::anyOrAssumedRank,
358362
Optionality::optional, common::Intent::In,
359-
{ArgFlag::canBeNull}}},
363+
{ArgFlag::canBeNullPointer}}},
360364
DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
361365
{"atan", {{"x", SameFloating}}, SameFloating},
362366
{"atan", {{"y", OperandReal}, {"x", OperandReal}}, OperandReal},
@@ -1892,9 +1896,9 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
18921896
d.keyword);
18931897
return std::nullopt;
18941898
}
1895-
if (!d.flags.test(ArgFlag::canBeNull)) {
1896-
if (const auto *expr{arg->UnwrapExpr()}; expr && IsNullPointer(*expr)) {
1897-
if (!IsBareNullPointer(expr) && IsNullObjectPointer(*expr) &&
1899+
if (!d.flags.test(ArgFlag::canBeNullPointer)) {
1900+
if (const auto *expr{arg->UnwrapExpr()}; IsNullPointer(expr)) {
1901+
if (!IsBareNullPointer(expr) && IsNullObjectPointer(expr) &&
18981902
d.flags.test(ArgFlag::canBeMoldNull)) {
18991903
// ok
19001904
} else {
@@ -1905,6 +1909,14 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
19051909
}
19061910
}
19071911
}
1912+
if (!d.flags.test(ArgFlag::canBeNullAllocatable) &&
1913+
IsNullAllocatable(arg->UnwrapExpr()) &&
1914+
!d.flags.test(ArgFlag::canBeMoldNull)) {
1915+
messages.Say(arg->sourceLocation(),
1916+
"A NULL() allocatable is not allowed for '%s=' intrinsic argument"_err_en_US,
1917+
d.keyword);
1918+
return std::nullopt;
1919+
}
19081920
if (d.flags.test(ArgFlag::notAssumedSize)) {
19091921
if (auto named{ExtractNamedEntity(*arg)}) {
19101922
if (semantics::IsAssumedSizeArray(named->GetLastSymbol())) {
@@ -2862,14 +2874,15 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
28622874
"MOLD= argument to NULL() must not be assumed-rank"_err_en_US);
28632875
}
28642876
bool isProcPtrTarget{
2865-
IsProcedurePointerTarget(*mold) && !IsNullObjectPointer(*mold)};
2877+
IsProcedurePointerTarget(*mold) && !IsNullObjectPointer(mold)};
28662878
if (isProcPtrTarget || IsAllocatableOrPointerObject(*mold)) {
28672879
characteristics::DummyArguments args;
28682880
std::optional<characteristics::FunctionResult> fResult;
2881+
bool isAllocatableMold{false};
28692882
if (isProcPtrTarget) {
28702883
// MOLD= procedure pointer
28712884
std::optional<characteristics::Procedure> procPointer;
2872-
if (IsNullProcedurePointer(*mold)) {
2885+
if (IsNullProcedurePointer(mold)) {
28732886
procPointer =
28742887
characteristics::Procedure::Characterize(*mold, context);
28752888
} else {
@@ -2885,20 +2898,23 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
28852898
fResult.emplace(std::move(*procPointer));
28862899
}
28872900
} else if (auto type{mold->GetType()}) {
2888-
// MOLD= object pointer
2901+
// MOLD= object pointer or allocatable
28892902
characteristics::TypeAndShape typeAndShape{
28902903
*type, GetShape(context, *mold)};
28912904
args.emplace_back(
28922905
"mold"s, characteristics::DummyDataObject{typeAndShape});
28932906
fResult.emplace(std::move(typeAndShape));
2907+
isAllocatableMold = IsAllocatableDesignator(*mold);
28942908
} else {
28952909
context.messages().Say(arguments[0]->sourceLocation(),
28962910
"MOLD= argument to NULL() lacks type"_err_en_US);
28972911
}
28982912
if (fResult) {
28992913
fResult->attrs.set(characteristics::FunctionResult::Attr::Pointer);
29002914
characteristics::Procedure::Attrs attrs;
2901-
attrs.set(characteristics::Procedure::Attr::NullPointer);
2915+
attrs.set(isAllocatableMold
2916+
? characteristics::Procedure::Attr::NullAllocatable
2917+
: characteristics::Procedure::Attr::NullPointer);
29022918
characteristics::Procedure chars{
29032919
std::move(*fResult), std::move(args), attrs};
29042920
return SpecificCall{SpecificIntrinsic{"null"s, std::move(chars)},
@@ -3257,7 +3273,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
32573273
const auto &arg{call.arguments[0]};
32583274
if (arg) {
32593275
if (const auto *expr{arg->UnwrapExpr()}) {
3260-
ok = evaluate::IsAllocatableDesignator(*expr);
3276+
ok = IsAllocatableDesignator(*expr) || IsNullAllocatable(expr);
32613277
}
32623278
}
32633279
if (!ok) {

‎flang/lib/Evaluate/shape.cpp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1173,8 +1173,10 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
11731173
if (call.arguments().size() >= 2) {
11741174
return (*this)(call.arguments()[1]); // MASK=
11751175
}
1176-
} else if (intrinsic->characteristics.value().attrs.test(characteristics::
1177-
Procedure::Attr::NullPointer)) { // NULL(MOLD=)
1176+
} else if (intrinsic->characteristics.value().attrs.test(
1177+
characteristics::Procedure::Attr::NullPointer) ||
1178+
intrinsic->characteristics.value().attrs.test(
1179+
characteristics::Procedure::Attr::NullAllocatable)) { // NULL(MOLD=)
11781180
return (*this)(call.arguments());
11791181
} else {
11801182
// TODO: shapes of other non-elemental intrinsic results

‎flang/lib/Evaluate/tools.cpp

Lines changed: 32 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -929,7 +929,7 @@ bool IsPointer(const Expr<SomeType> &expr) {
929929
}
930930

931931
bool IsProcedurePointer(const Expr<SomeType> &expr) {
932-
if (IsNullProcedurePointer(expr)) {
932+
if (IsNullProcedurePointer(&expr)) {
933933
return true;
934934
} else if (const auto *funcRef{UnwrapProcedureRef(expr)}) {
935935
if (const Symbol * proc{funcRef->proc().GetSymbol()}) {
@@ -963,7 +963,7 @@ bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
963963
}
964964

965965
bool IsObjectPointer(const Expr<SomeType> &expr) {
966-
if (IsNullObjectPointer(expr)) {
966+
if (IsNullObjectPointer(&expr)) {
967967
return true;
968968
} else if (IsProcedurePointerTarget(expr)) {
969969
return false;
@@ -1030,22 +1030,46 @@ template <bool IS_PROC_PTR> struct IsNullPointerHelper {
10301030
}
10311031
};
10321032

1033-
bool IsNullObjectPointer(const Expr<SomeType> &expr) {
1034-
return IsNullPointerHelper<false>{}(expr);
1033+
bool IsNullObjectPointer(const Expr<SomeType> *expr) {
1034+
return expr && IsNullPointerHelper<false>{}(*expr);
10351035
}
10361036

1037-
bool IsNullProcedurePointer(const Expr<SomeType> &expr) {
1038-
return IsNullPointerHelper<true>{}(expr);
1037+
bool IsNullProcedurePointer(const Expr<SomeType> *expr) {
1038+
return expr && IsNullPointerHelper<true>{}(*expr);
10391039
}
10401040

1041-
bool IsNullPointer(const Expr<SomeType> &expr) {
1041+
bool IsNullPointer(const Expr<SomeType> *expr) {
10421042
return IsNullObjectPointer(expr) || IsNullProcedurePointer(expr);
10431043
}
10441044

10451045
bool IsBareNullPointer(const Expr<SomeType> *expr) {
10461046
return expr && std::holds_alternative<NullPointer>(expr->u);
10471047
}
10481048

1049+
struct IsNullAllocatableHelper {
1050+
template <typename A> bool operator()(const A &) const { return false; }
1051+
template <typename T> bool operator()(const FunctionRef<T> &call) const {
1052+
const auto *intrinsic{call.proc().GetSpecificIntrinsic()};
1053+
return intrinsic &&
1054+
intrinsic->characteristics.value().attrs.test(
1055+
characteristics::Procedure::Attr::NullAllocatable);
1056+
}
1057+
template <typename T> bool operator()(const Parentheses<T> &x) const {
1058+
return (*this)(x.left());
1059+
}
1060+
template <typename T> bool operator()(const Expr<T> &x) const {
1061+
return common::visit(*this, x.u);
1062+
}
1063+
};
1064+
1065+
bool IsNullAllocatable(const Expr<SomeType> *x) {
1066+
return x && IsNullAllocatableHelper{}(*x);
1067+
}
1068+
1069+
bool IsNullPointerOrAllocatable(const Expr<SomeType> *x) {
1070+
return IsNullPointer(x) || IsNullAllocatable(x);
1071+
}
1072+
10491073
// GetSymbolVector()
10501074
auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
10511075
if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
@@ -1393,7 +1417,7 @@ bool IsAllocatableOrPointerObject(const Expr<SomeType> &expr) {
13931417
const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
13941418
return (sym &&
13951419
semantics::IsAllocatableOrObjectPointer(&sym->GetUltimate())) ||
1396-
evaluate::IsObjectPointer(expr);
1420+
evaluate::IsObjectPointer(expr) || evaluate::IsNullAllocatable(&expr);
13971421
}
13981422

13991423
bool IsAllocatableDesignator(const Expr<SomeType> &expr) {

‎flang/lib/Lower/ConvertConstant.cpp

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -370,7 +370,7 @@ static mlir::Value genStructureComponentInit(
370370
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
371371

372372
if (Fortran::semantics::IsAllocatable(sym)) {
373-
if (!Fortran::evaluate::IsNullPointer(expr)) {
373+
if (!Fortran::evaluate::IsNullPointerOrAllocatable(&expr)) {
374374
fir::emitFatalError(loc, "constant structure constructor with an "
375375
"allocatable component value that is not NULL");
376376
} else {
@@ -414,7 +414,7 @@ static mlir::Value genStructureComponentInit(
414414
// must fall through to genConstantValue() below.
415415
if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 &&
416416
(Fortran::evaluate::GetLastSymbol(expr) ||
417-
Fortran::evaluate::IsNullPointer(expr))) {
417+
Fortran::evaluate::IsNullPointer(&expr))) {
418418
// Builtin c_ptr and c_funptr have special handling because designators
419419
// and NULL() are handled as initial values for them as an extension
420420
// (otherwise only c_ptr_null/c_funptr_null are allowed and these are

0 commit comments

Comments
 (0)