diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 0dc8e121ea165..f234241cfe14a 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2094,7 +2094,7 @@ std::optional IntrinsicInterface::Match( const ActualArgument *arrayArg{nullptr}; const char *arrayArgName{nullptr}; const ActualArgument *knownArg{nullptr}; - std::optional shapeArgSize; + std::optional shapeArgSize; int elementalRank{0}; for (std::size_t j{0}; j < dummies; ++j) { const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]}; @@ -2133,14 +2133,20 @@ std::optional IntrinsicInterface::Match( if (auto shape{GetShape(context, *arg)}) { if (auto constShape{AsConstantShape(context, *shape)}) { shapeArgSize = constShape->At(ConstantSubscripts{1}).ToInt64(); - CHECK(*shapeArgSize >= 0); - argOk = true; + CHECK(shapeArgSize.value() >= 0); + argOk = *shapeArgSize <= common::maxRank; } } } if (!argOk) { - messages.Say(arg->sourceLocation(), - "'shape=' argument must be a vector of known size"_err_en_US); + if (shapeArgSize.value_or(0) > common::maxRank) { + messages.Say(arg->sourceLocation(), + "'shape=' argument must be a vector of at most %d elements (has %jd)"_err_en_US, + common::maxRank, std::intmax_t{*shapeArgSize}); + } else { + messages.Say(arg->sourceLocation(), + "'shape=' argument must be a vector of known size"_err_en_US); + } return std::nullopt; } break; diff --git a/flang/test/Semantics/reshape.f90 b/flang/test/Semantics/reshape.f90 index b3b96985affc7..cccba210885a6 100644 --- a/flang/test/Semantics/reshape.f90 +++ b/flang/test/Semantics/reshape.f90 @@ -53,10 +53,9 @@ program reshaper !ERROR: 'shape=' argument has too many elements integer :: array23(I64_MAX, I64_MAX) = RESHAPE([1, 2, 3], huge_shape) - !ERROR: Size of 'shape=' argument must not be greater than 15 CALL ext_sub(RESHAPE([(n, n=1,20)], & + !ERROR: 'shape=' argument must be a vector of at most 15 elements (has 16) [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1])) - !ERROR: Reference to the procedure 'ext_sub' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes !ERROR: 'shape=' argument must not have a negative extent CALL ext_sub(RESHAPE([(n, n=1,20)], [1, -5, 3])) !ERROR: 'order=' argument has unacceptable rank 2