if (const auto *expr{arg.UnwrapExpr()}) {
if (IsBOZLiteral(*expr)) {
messages.Say("BOZ argument requires an explicit interface"_err_en_US);
- }
- if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
+ } else if (evaluate::IsNullPointer(*expr)) {
+ messages.Say(
+ "Null pointer argument requires an explicit interface"_err_en_US);
+ } else if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
const Symbol &symbol{named->GetLastSymbol()};
if (symbol.Corank() > 0) {
messages.Say(
}
}
}
+
+ // NULL(MOLD=) checking for non-intrinsic procedures
+ bool dummyIsOptional{
+ dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
+ bool actualIsNull{evaluate::IsNullPointer(actual)};
+ if (!intrinsic && !dummyIsPointer && !dummyIsOptional && actualIsNull) {
+ messages.Say(
+ "Actual argument associated with %s may not be null pointer %s"_err_en_US,
+ dummyName, actual.AsFortran());
+ }
}
static void CheckProcedureArg(evaluate::ActualArgument &arg,
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
evaluate::IsNullPointer(*expr)) {
// ok, ASSOCIATED(NULL())
- } else if (object.attrs.test(
- characteristics::DummyDataObject::Attr::Pointer) &&
+ } else if ((object.attrs.test(characteristics::DummyDataObject::
+ Attr::Pointer) ||
+ object.attrs.test(characteristics::
+ DummyDataObject::Attr::Optional)) &&
evaluate::IsNullPointer(*expr)) {
// ok, FOO(NULL())
} else {
if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape,
"pointer", "function result", false /*elemental*/,
evaluate::CheckConformanceFlags::BothDeferredShape)) {
- msg = "%s is associated with the result of a reference to function '%s'"
- " whose pointer result has an incompatible type or shape"_err_en_US;
+ return false; // IsCompatibleWith() emitted message
}
}
if (msg) {
subroutine s1(j)
integer, intent(in) :: j
end subroutine
+ subroutine canbenull(x, y)
+ integer, intent(in), optional :: x
+ real, intent(in), pointer :: y
+ end
function f0()
real :: f0
end function
procedure(s1), pointer :: f3
end function
end interface
+ external implicit
type :: dt0
integer, pointer :: ip0
end type dt0
dt0x = dt0(ip0=null(ip0))
dt0x = dt0(ip0=null(mold=ip0))
!ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
- !ERROR: pointer 'ip0' is associated with the result of a reference to function 'null' whose pointer result has an incompatible type or shape
dt0x = dt0(ip0=null(mold=rp0))
!ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
- !ERROR: pointer 'ip1' is associated with the result of a reference to function 'null' whose pointer result has an incompatible type or shape
dt1x = dt1(ip1=null(mold=rp1))
dt2x = dt2(pps0=null())
dt2x = dt2(pps0=null(mold=dt2x%pps0))
!ERROR: Procedure pointer 'pps1' associated with result of reference to function 'null' that is an incompatible procedure pointer
dt3x = dt3(pps1=null(mold=dt2x%pps0))
dt3x = dt3(pps1=null(mold=dt3x%pps1))
+ call canbenull(null(), null()) ! fine
+ call canbenull(null(mold=ip0), null(mold=rp0)) ! fine
+ !ERROR: Null pointer argument requires an explicit interface
+ call implicit(null())
+ !ERROR: Null pointer argument requires an explicit interface
+ call implicit(null(mold=ip0))
end subroutine test