[flang] Allow NULL() actual argument for pointer dummy

Fixes a bogus error message about an actual argument not being an
object.

Differential Revision: https://reviews.llvm.org/D95176
This commit is contained in:
peter klausler 2021-01-21 14:50:57 -08:00
parent 020c00b5d3
commit 0cfadb37f4
1 changed files with 13 additions and 9 deletions

View File

@ -139,8 +139,8 @@ static bool DefersSameTypeParameters(
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
characteristics::TypeAndShape &actualType, bool isElemental,
bool actualIsArrayElement, evaluate::FoldingContext &context,
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
evaluate::FoldingContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic *intrinsic) {
// Basic type & rank checking
parser::ContextualMessages &messages{context.messages()};
@ -153,7 +153,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
characteristics::TypeAndShape::Attr::AssumedRank)) {
} else if (!dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape) &&
(actualType.Rank() > 0 || actualIsArrayElement)) {
(actualType.Rank() > 0 || IsArrayElement(actual))) {
// Sequence association (15.5.2.11) applies -- rank need not match
// if the actual argument is an array or array element designator.
} else {
@ -271,8 +271,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
: nullptr};
int actualRank{evaluate::GetRank(actualType.shape())};
bool actualIsPointer{(actualLastSymbol && IsPointer(*actualLastSymbol)) ||
evaluate::IsNullPointer(actual)};
bool actualIsPointer{evaluate::IsObjectPointer(actual, context)};
if (dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)) {
// 15.5.2.4(16)
@ -293,7 +292,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
"Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
dummyName);
}
if (actualLastSymbol && actualLastSymbol->Rank() == 0 &&
if (!IsArrayElement(actual) &&
!(actualType.type().category() == TypeCategory::Character &&
actualType.type().kind() == 1) &&
!(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) {
messages.Say(
"Whole scalar actual argument may not be associated with a %s array"_err_en_US,
@ -624,15 +625,18 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
arg.set_dummyIntent(object.intent);
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
isElemental, IsArrayElement(*expr), context, scope,
intrinsic);
isElemental, context, scope, intrinsic);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) {
// ok
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
evaluate::IsNullPointer(*expr)) {
// ok, calling ASSOCIATED(NULL())
// ok, ASSOCIATED(NULL())
} else if (object.attrs.test(
characteristics::DummyDataObject::Attr::Pointer) &&
evaluate::IsNullPointer(*expr)) {
// ok, FOO(NULL())
} else {
messages.Say(
"Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,