Commit bcb2591b authored by peter klausler's avatar peter klausler
Browse files

[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
parent 757384ab

flang/lib/Semantics/check-call.cpp

+18 −4
Original line number Diff line number Diff line
@@ -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 {

flang/lib/Semantics/pointer-assignment.cpp

+1 −2
Original line number Diff line number Diff line
@@ -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) {

flang/test/Semantics/null01.f90

+11 −2
Original line number Diff line number Diff line
@@ -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