diff options
author | Peter Klausler <35819229+klausler@users.noreply.github.com> | 2024-03-05 11:09:48 -0800 |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-03-05 11:09:48 -0800 |
commit | 9a20612d960bbcbf6bd59d2d94400574a3cccde0 (patch) | |
tree | 9c5f35e0efe459eda45502ac5de23ce6ee98710b | |
parent | 17162b61c2e6968482fab928f89bdca8b4ac06d9 (diff) | |
download | llvm-9a20612d960bbcbf6bd59d2d94400574a3cccde0.zip llvm-9a20612d960bbcbf6bd59d2d94400574a3cccde0.tar.gz llvm-9a20612d960bbcbf6bd59d2d94400574a3cccde0.tar.bz2 |
[flang] NULL(NULL(NULL(...(NULL()...))) means NULL() (#83738)
When the actual MOLD= argument of a reference to the intrinsic function
NULL is itself just NULL() (possibly nested), treat the MOLD= as if it
had not been present.
Fixes https://github.com/llvm/llvm-project/issues/83572.
-rw-r--r-- | flang/lib/Evaluate/intrinsics.cpp | 33 | ||||
-rw-r--r-- | flang/test/Semantics/null01.f90 | 10 |
2 files changed, 33 insertions, 10 deletions
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index a8f2e5b..9b98d22 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2635,19 +2635,30 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull( static const char *const keywords[]{"mold", nullptr}; if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1) && arguments[0]) { - if (Expr<SomeType> * mold{arguments[0]->UnwrapExpr()}) { - bool isProcPtrTarget{IsProcedurePointerTarget(*mold)}; + Expr<SomeType> *mold{arguments[0]->UnwrapExpr()}; + bool isBareNull{IsBareNullPointer(mold)}; + if (isBareNull) { + // NULL(NULL()), NULL(NULL(NULL())), &c. are all just NULL() + mold = nullptr; + } + if (mold) { + bool isProcPtrTarget{ + IsProcedurePointerTarget(*mold) && !IsNullObjectPointer(*mold)}; if (isProcPtrTarget || IsAllocatableOrPointerObject(*mold)) { characteristics::DummyArguments args; std::optional<characteristics::FunctionResult> fResult; if (isProcPtrTarget) { // MOLD= procedure pointer - const Symbol *last{GetLastSymbol(*mold)}; - CHECK(last); - auto procPointer{IsProcedure(*last) - ? characteristics::Procedure::Characterize(*last, context) - : std::nullopt}; - // procPointer is null if there was an error with the analysis + std::optional<characteristics::Procedure> procPointer; + if (IsNullProcedurePointer(*mold)) { + procPointer = + characteristics::Procedure::Characterize(*mold, context); + } else { + const Symbol *last{GetLastSymbol(*mold)}; + procPointer = + characteristics::Procedure::Characterize(DEREF(last), context); + } + // procPointer is vacant if there was an error with the analysis // associated with the procedure pointer if (procPointer) { args.emplace_back("mold"s, @@ -2676,8 +2687,10 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull( } } } - context.messages().Say(arguments[0]->sourceLocation(), - "MOLD= argument to NULL() must be a pointer or allocatable"_err_en_US); + if (!isBareNull) { + context.messages().Say(arguments[0]->sourceLocation(), + "MOLD= argument to NULL() must be a pointer or allocatable"_err_en_US); + } } characteristics::Procedure::Attrs attrs; attrs.set(characteristics::Procedure::Attr::NullPointer); diff --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90 index 71567fb..b61d464 100644 --- a/flang/test/Semantics/null01.f90 +++ b/flang/test/Semantics/null01.f90 @@ -65,12 +65,22 @@ subroutine test real(kind=eight) :: r8check logical, pointer :: lp ip0 => null() ! ok + ip0 => null(null()) ! ok + ip0 => null(null(null())) ! ok ip1 => null() ! ok + ip1 => null(null()) ! ok + ip1 => null(null(null())) ! ok ip2 => null() ! ok + ip2 => null(null()) ! ok + ip2 => null(null(null())) ! ok !ERROR: MOLD= argument to NULL() must be a pointer or allocatable ip0 => null(mold=1) !ERROR: MOLD= argument to NULL() must be a pointer or allocatable + ip0 => null(null(mold=1)) + !ERROR: MOLD= argument to NULL() must be a pointer or allocatable ip0 => null(mold=j) + !ERROR: MOLD= argument to NULL() must be a pointer or allocatable + ip0 => null(mold=null(mold=j)) dt0x = dt0(null()) dt0x = dt0(ip0=null()) dt0x = dt0(ip0=null(ip0)) |