replica
/
hanchenye-llvm-project
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[flang] More checking of NULL pointer actual arguments 

Catch additional missing error cases for typed and untyped
NULL actual arguments to non-intrinsic procedures in cases
of explicit and implicit interfaces.

Differential Revision: https://reviews.llvm.org/D110003
This commit is contained in:
peter klausler 2021-09-17 08:19:10 -07:00
parent 757384abff
commit bcb2591b6c
3 changed files with 30 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
flang/lib/Semantics/check-call.cpp
View File

@ -48,8 +48,10 @@ static void CheckImplicitInterfaceArg(
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(
@ -499,6 +501,16 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
}
// 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,
@ -641,8 +653,10 @@ static void CheckExplicitInterfaceArg(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 {

3
flang/lib/Semantics/pointer-assignment.cpp
View File

@ -174,8 +174,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
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) {

13
flang/test/Semantics/null01.f90
View File

@ -8,6 +8,10 @@ subroutine test
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
@ -25,6 +29,7 @@ subroutine test
procedure(s1), pointer :: f3
end function
end interface
external implicit
type :: dt0
integer, pointer :: ip0
end type dt0
@ -62,10 +67,8 @@ subroutine test
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))
@ -74,4 +77,10 @@ subroutine test
!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