[flang] Catch errors with intrinsic array inquiry functions

The intrinsic inquiry functions SIZE and UBOUND -- but not LBOUND --
require a DIM= argument if their first argument is an assumed-size
array.  The intrinsic SHAPE must not be used with an assumed-size
array.

Differential Revision: https://reviews.llvm.org/D109912
This commit is contained in:
peter klausler 2021-09-10 17:35:47 -07:00
parent e2febc2ed4
commit 7ff920826c
2 changed files with 56 additions and 4 deletions

View File

@ -189,7 +189,9 @@ ENUM_CLASS(Rank,
shaped, // rank is length of SHAPE vector
)
ENUM_CLASS(Optionality, required, optional, missing,
ENUM_CLASS(Optionality, required,
optional, // unless DIM= for SIZE(assumedSize)
missing, // for DIM= cases like FINDLOC
defaultsToSameKind, // for MatchingDefaultKIND
defaultsToDefaultForResult, // for DefaultingKIND
defaultsToSizeKind, // for SizeDefaultKIND
@ -722,7 +724,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"sind", {{"x", SameFloating}}, SameFloating},
{"sinh", {{"x", SameFloating}}, SameFloating},
{"size",
{{"array", AnyData, Rank::anyOrAssumedRank}, OptionalDIM,
{{"array", AnyData, Rank::anyOrAssumedRank},
OptionalDIM, // unless array is assumed-size
SizeDefaultKIND},
KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"sizeof", {{"a", AnyData, Rank::anyOrAssumedRank}}, SubscriptInt,
@ -1372,7 +1375,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
if (const ActualArgument * arg{actualForDummy[j]}) {
if (IsAssumedRank(*arg) && d.rank != Rank::anyOrAssumedRank) {
bool isAssumedRank{IsAssumedRank(*arg)};
if (isAssumedRank && d.rank != Rank::anyOrAssumedRank) {
messages.Say("Assumed-rank array cannot be forwarded to "
"'%s=' argument"_err_en_US,
d.keyword);
@ -1443,6 +1447,31 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
argOk = rank == knownArg->Rank();
break;
case Rank::anyOrAssumedRank:
if (!hasDimArg && rank > 0 && !isAssumedRank &&
(std::strcmp(name, "shape") == 0 ||
std::strcmp(name, "size") == 0 ||
std::strcmp(name, "ubound") == 0)) {
// Check for an assumed-size array argument.
// These are disallowed for SHAPE, and require DIM= for
// SIZE and UBOUND.
// (A previous error message for UBOUND will take precedence
// over this one, as this error is caught by the second entry
// for UBOUND.)
if (std::optional<Shape> shape{GetShape(context, *arg)}) {
if (!shape->empty() && !shape->back().has_value()) {
if (strcmp(name, "shape") == 0) {
messages.Say(
"The '%s=' argument to the intrinsic function '%s' may not be assumed-size"_err_en_US,
d.keyword, name);
} else {
messages.Say(
"A dim= argument is required for '%s' when the array is assumed-size"_err_en_US,
name);
}
return std::nullopt;
}
}
}
argOk = true;
break;
case Rank::conformable: // arg must be conformable with previous arrayArg
@ -1450,7 +1479,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
CHECK(arrayArgName);
if (const std::optional<Shape> &arrayArgShape{
GetShape(context, *arrayArg)}) {
if (const std::optional<Shape> &argShape{GetShape(context, *arg)}) {
if (std::optional<Shape> argShape{GetShape(context, *arg)}) {
std::string arrayArgMsg{"'"};
arrayArgMsg = arrayArgMsg + arrayArgName + "='" + " argument";
std::string argMsg{"'"};

View File

@ -0,0 +1,23 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! Miscellaneous constraint and requirement checking on intrinsics
program test_size
real, dimension(5, 5) :: array
call test(array)
contains
subroutine test(arg)
real, dimension(5, *) :: arg
!ERROR: A dim= argument is required for 'size' when the array is assumed-size
print *, size(arg)
!ERROR: missing mandatory 'dim=' argument
print *, ubound(arg)
!ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
print *, shape(arg)
! But these cases are fine:
print *, size(arg, dim=1)
print *, ubound(arg, dim=1)
print *, lbound(arg)
print *, size(array)
print *, ubound(array)
print *, lbound(array)
end subroutine
end