diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp index 79d57d0b394fa..aa9246fb223e0 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -267,11 +267,10 @@ std::optional WhyNotDefinable(parser::CharBlock at, expr.AsFortran()); } return WhyNotDefinable(at, scope, flags, *dataRef); - } - if (evaluate::IsVariable(expr)) { - return std::nullopt; // result of function returning a pointer - ok - } - if (flags.test(DefinabilityFlag::PointerDefinition)) { + } else if (evaluate::IsNullPointer(expr)) { + return parser::Message{ + at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()}; + } else if (flags.test(DefinabilityFlag::PointerDefinition)) { if (const auto *procDesignator{ std::get_if(&expr.u)}) { // Defining a procedure pointer @@ -288,13 +287,14 @@ std::optional WhyNotDefinable(parser::CharBlock at, } } } - } - if (evaluate::IsNullPointer(expr)) { return parser::Message{ - at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()}; + at, "'%s' is not a definable pointer"_because_en_US, expr.AsFortran()}; + } else if (!evaluate::IsVariable(expr)) { + return parser::Message{at, + "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()}; + } else { + return std::nullopt; } - return parser::Message{ - at, "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()}; } } // namespace Fortran::semantics diff --git a/flang/test/Semantics/definable04.f90 b/flang/test/Semantics/definable04.f90 new file mode 100644 index 0000000000000..f9a5e045de1f0 --- /dev/null +++ b/flang/test/Semantics/definable04.f90 @@ -0,0 +1,27 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +module m + integer, target :: n + contains + function ptr() + integer, pointer :: ptr + ptr => n + end + subroutine s1(p) + integer, pointer, intent(in) :: p + end + subroutine s2(p) + integer, pointer, intent(in out) :: p + end +end + +program test + use m + integer, pointer :: p + p => ptr() ! ok + ptr() = 1 ! ok + call s1(ptr()) ! ok + call s1(null()) ! ok + !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'p=' is not definable + !BECAUSE: 'ptr()' is not a definable pointer + call s2(ptr()) +end