@@ -139,8 +139,8 @@ static bool DefersSameTypeParameters(
139
139
static void CheckExplicitDataArg (const characteristics::DummyDataObject &dummy,
140
140
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
141
141
characteristics::TypeAndShape &actualType, bool isElemental,
142
- bool actualIsArrayElement, evaluate::FoldingContext &context,
143
- const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
142
+ evaluate::FoldingContext &context, const Scope *scope ,
143
+ const evaluate::SpecificIntrinsic *intrinsic) {
144
144
145
145
// Basic type & rank checking
146
146
parser::ContextualMessages &messages{context.messages ()};
@@ -153,7 +153,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
153
153
characteristics::TypeAndShape::Attr::AssumedRank)) {
154
154
} else if (!dummy.type .attrs ().test (
155
155
characteristics::TypeAndShape::Attr::AssumedShape) &&
156
- (actualType.Rank () > 0 || actualIsArrayElement )) {
156
+ (actualType.Rank () > 0 || IsArrayElement (actual) )) {
157
157
// Sequence association (15.5.2.11) applies -- rank need not match
158
158
// if the actual argument is an array or array element designator.
159
159
} else {
@@ -271,8 +271,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
271
271
? actualLastSymbol->detailsIf <ObjectEntityDetails>()
272
272
: nullptr };
273
273
int actualRank{evaluate::GetRank (actualType.shape ())};
274
- bool actualIsPointer{(actualLastSymbol && IsPointer (*actualLastSymbol)) ||
275
- evaluate::IsNullPointer (actual)};
274
+ bool actualIsPointer{evaluate::IsObjectPointer (actual, context)};
276
275
if (dummy.type .attrs ().test (
277
276
characteristics::TypeAndShape::Attr::AssumedShape)) {
278
277
// 15.5.2.4(16)
@@ -293,7 +292,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
293
292
" Coindexed scalar actual argument must be associated with a scalar %s" _err_en_US,
294
293
dummyName);
295
294
}
296
- if (actualLastSymbol && actualLastSymbol->Rank () == 0 &&
295
+ if (!IsArrayElement (actual) &&
296
+ !(actualType.type ().category () == TypeCategory::Character &&
297
+ actualType.type ().kind () == 1 ) &&
297
298
!(dummy.type .type ().IsAssumedType () && dummyIsAssumedSize)) {
298
299
messages.Say (
299
300
" 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,
624
625
arg.set_dummyIntent (object.intent );
625
626
bool isElemental{object.type .Rank () == 0 && proc.IsElemental ()};
626
627
CheckExplicitDataArg (object, dummyName, *expr, *type,
627
- isElemental, IsArrayElement (*expr), context, scope,
628
- intrinsic);
628
+ isElemental, context, scope, intrinsic);
629
629
} else if (object.type .type ().IsTypelessIntrinsicArgument () &&
630
630
std::holds_alternative<evaluate::BOZLiteralConstant>(
631
631
expr->u )) {
632
632
// ok
633
633
} else if (object.type .type ().IsTypelessIntrinsicArgument () &&
634
634
evaluate::IsNullPointer (*expr)) {
635
- // ok, calling ASSOCIATED(NULL())
635
+ // ok, ASSOCIATED(NULL())
636
+ } else if (object.attrs .test (
637
+ characteristics::DummyDataObject::Attr::Pointer) &&
638
+ evaluate::IsNullPointer (*expr)) {
639
+ // ok, FOO(NULL())
636
640
} else {
637
641
messages.Say (
638
642
" Actual argument '%s' associated with %s is not a variable or typed expression" _err_en_US,
0 commit comments