diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 21db9a4b82b2c..bb5e6ea4cd376 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -654,10 +654,11 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result { } else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) { if (intrinsic->name == "shape" || intrinsic->name == "lbound" || intrinsic->name == "ubound") { - // These are the array-valued cases for LBOUND and UBOUND (no DIM=). - const auto *expr{call.arguments().front().value().UnwrapExpr()}; - CHECK(expr); - return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}}; + // For LBOUND/UBOUND, these are the array-valued cases (no DIM=) + if (!call.arguments().empty() && call.arguments().front()) { + return Shape{ + MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}}; + } } else if (intrinsic->name == "all" || intrinsic->name == "any" || intrinsic->name == "count" || intrinsic->name == "iall" || intrinsic->name == "iany" || intrinsic->name == "iparity" || diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 56c4021a21e8f..d55efa84a11b1 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -699,14 +699,13 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, messages.Say( "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US, assumed.name(), dummyName); - } else { - const auto *details{assumed.detailsIf()}; - if (!(IsAssumedShape(assumed) || - (details && details->IsAssumedRank()))) { - messages.Say( // C711 - "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed-type %s"_err_en_US, - assumed.name(), dummyName); - } + } else if (object.type.attrs().test(evaluate::characteristics:: + TypeAndShape::Attr::AssumedRank) && + !IsAssumedShape(assumed) && + !evaluate::IsAssumedRank(assumed)) { + messages.Say( // C711 + "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US, + assumed.name(), dummyName); } } }, diff --git a/flang/test/Semantics/call15.f90 b/flang/test/Semantics/call15.f90 index 842103b4aca30..e91a2ec282275 100644 --- a/flang/test/Semantics/call15.f90 +++ b/flang/test/Semantics/call15.f90 @@ -1,5 +1,5 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 -! C711 An assumed-type actual argument that corresponds to an assumed-rank +! C711 An assumed-type actual argument that corresponds to an assumed-rank ! dummy argument shall be assumed-shape or assumed-rank. subroutine s(arg1, arg2, arg3) type(*), dimension(..) :: arg1 ! assumed rank @@ -8,7 +8,7 @@ subroutine s(arg1, arg2, arg3) call inner(arg1) ! OK, assumed rank call inner(arg2) ! OK, assumed shape - !ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed-type dummy argument 'dummy=' + !ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed rank dummy argument 'dummy=' call inner(arg3) contains