[flang] Fold LCOBOUND & UCOBOUND (#121411)

Implement constant folding for LCOBOUND and UCOBOUND intrinsic
functions. Moves some error detection code from intrinsics.cpp to
fold-integer.cpp so that erroneous calls get properly flagged and
converted into known errors.
This commit is contained in:
Peter Klausler 2025-01-08 13:13:30 -08:00 committed by GitHub
parent d1ea605ecd
commit 9496391901
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
6 changed files with 139 additions and 41 deletions

View File

@ -117,6 +117,14 @@ MaybeExtentExpr GetExtent(const Subscript &, const NamedEntity &, int dimension,
MaybeExtentExpr GetExtent(FoldingContext &, const Subscript &,
const NamedEntity &, int dimension, bool invariantOnly = true);
// Similar analyses for coarrays
MaybeExtentExpr GetLCOBOUND(
const Symbol &, int dimension, bool invariantOnly = true);
MaybeExtentExpr GetUCOBOUND(
const Symbol &, int dimension, bool invariantOnly = true);
Shape GetLCOBOUNDs(const Symbol &, bool invariantOnly = true);
Shape GetUCOBOUNDs(const Symbol &, bool invariantOnly = true);
// Compute an element count for a triplet or trip count for a DO.
ExtentExpr CountTrips(
ExtentExpr &&lower, ExtentExpr &&upper, ExtentExpr &&stride);

View File

@ -71,6 +71,28 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
return true;
}
static bool CheckCoDimArg(const std::optional<ActualArgument> &dimArg,
const Symbol &symbol, parser::ContextualMessages &messages,
std::optional<int> &dimVal) {
dimVal.reset();
if (int corank{symbol.Corank()}; corank > 0) {
if (auto dim64{ToInt64(dimArg)}) {
if (*dim64 < 1) {
messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
return false;
} else if (*dim64 > corank) {
messages.Say(
"DIM=%jd dimension is out of range for corank-%d coarray"_err_en_US,
*dim64, corank);
return false;
} else {
dimVal = static_cast<int>(*dim64 - 1); // 1-based to 0-based
}
}
}
return true;
}
// Class to retrieve the constant bound of an expression which is an
// array that devolves to a type of Constant<T>
class GetConstantArrayBoundHelper {
@ -264,6 +286,37 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
return Expr<T>{std::move(funcRef)};
}
// LCOBOUND() & UCOBOUND()
template <int KIND>
Expr<Type<TypeCategory::Integer, KIND>> COBOUND(FoldingContext &context,
FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef, bool isUCOBOUND) {
using T = Type<TypeCategory::Integer, KIND>;
ActualArguments &args{funcRef.arguments()};
if (const Symbol * coarray{UnwrapWholeSymbolOrComponentDataRef(args[0])}) {
std::optional<int> dim;
if (funcRef.Rank() == 0) {
// Optional DIM= argument is present: result is scalar.
if (!CheckCoDimArg(args[1], *coarray, context.messages(), dim)) {
return MakeInvalidIntrinsic<T>(std::move(funcRef));
} else if (!dim) {
// DIM= is present but not constant, or error
return Expr<T>{std::move(funcRef)};
}
}
if (dim) {
if (auto cb{isUCOBOUND ? GetUCOBOUND(*coarray, *dim)
: GetLCOBOUND(*coarray, *dim)}) {
return Fold(context, ConvertToType<T>(std::move(*cb)));
}
} else if (auto cbs{
AsExtentArrayExpr(isUCOBOUND ? GetUCOBOUNDs(*coarray)
: GetLCOBOUNDs(*coarray))}) {
return Fold(context, ConvertToType<T>(Expr<ExtentType>{std::move(*cbs)}));
}
}
return Expr<T>{std::move(funcRef)};
}
// COUNT()
template <typename T, int MASK_KIND> class CountAccumulator {
using MaskT = Type<TypeCategory::Logical, MASK_KIND>;
@ -1105,6 +1158,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "lbound") {
return LBOUND(context, std::move(funcRef));
} else if (name == "lcobound") {
return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/false);
} else if (name == "leadz" || name == "trailz" || name == "poppar" ||
name == "popcnt") {
if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
@ -1396,6 +1451,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
} else if (name == "ucobound") {
return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/true);
} else if (name == "__builtin_numeric_storage_size") {
if (!context.moduleFileName()) {
// Don't fold this reference until it appears in the module file

View File

@ -3189,27 +3189,6 @@ static bool CheckForNonPositiveValues(FoldingContext &context,
return ok;
}
static bool CheckDimAgainstCorank(SpecificCall &call, FoldingContext &context) {
bool ok{true};
if (const auto &coarrayArg{call.arguments[0]}) {
if (const auto &dimArg{call.arguments[1]}) {
if (const auto *symbol{
UnwrapWholeSymbolDataRef(coarrayArg->UnwrapExpr())}) {
const auto corank = symbol->Corank();
if (const auto dimNum{ToInt64(dimArg->UnwrapExpr())}) {
if (dimNum < 1 || dimNum > corank) {
ok = false;
context.messages().Say(dimArg->sourceLocation(),
"DIM=%jd dimension is out of range for coarray with corank %d"_err_en_US,
static_cast<std::intmax_t>(*dimNum), corank);
}
}
}
}
}
return ok;
}
static bool CheckAtomicDefineAndRef(FoldingContext &context,
const std::optional<ActualArgument> &atomArg,
const std::optional<ActualArgument> &valueArg,
@ -3277,8 +3256,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
if (const auto &arg{call.arguments[0]}) {
ok = CheckForNonPositiveValues(context, *arg, name, "image");
}
} else if (name == "lcobound") {
return CheckDimAgainstCorank(call, context);
} else if (name == "loc") {
const auto &arg{call.arguments[0]};
ok =
@ -3288,8 +3265,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
arg ? arg->sourceLocation() : context.messages().at(),
"Argument of LOC() must be an object or procedure"_err_en_US);
}
} else if (name == "ucobound") {
return CheckDimAgainstCorank(call, context);
}
return ok;
}

View File

@ -723,6 +723,58 @@ Shape GetUBOUNDs(const NamedEntity &base, bool invariantOnly) {
return GetUBOUNDs(nullptr, base, invariantOnly);
}
MaybeExtentExpr GetLCOBOUND(
const Symbol &symbol0, int dimension, bool invariantOnly) {
const Symbol &symbol{ResolveAssociations(symbol0)};
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
int corank{object->coshape().Rank()};
if (dimension < corank) {
const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
if (const auto &lcobound{shapeSpec.lbound().GetExplicit()}) {
if (!invariantOnly || IsScopeInvariantExpr(*lcobound)) {
return *lcobound;
}
}
}
}
return std::nullopt;
}
MaybeExtentExpr GetUCOBOUND(
const Symbol &symbol0, int dimension, bool invariantOnly) {
const Symbol &symbol{ResolveAssociations(symbol0)};
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
int corank{object->coshape().Rank()};
if (dimension < corank - 1) {
const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
if (const auto ucobound{shapeSpec.ubound().GetExplicit()}) {
if (!invariantOnly || IsScopeInvariantExpr(*ucobound)) {
return *ucobound;
}
}
}
}
return std::nullopt;
}
Shape GetLCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
Shape result;
int corank{symbol.Corank()};
for (int dim{0}; dim < corank; ++dim) {
result.emplace_back(GetLCOBOUND(symbol, dim, invariantOnly));
}
return result;
}
Shape GetUCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
Shape result;
int corank{symbol.Corank()};
for (int dim{0}; dim < corank; ++dim) {
result.emplace_back(GetUCOBOUND(symbol, dim, invariantOnly));
}
return result;
}
auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
return common::visit(
common::visitors{

View File

@ -11,6 +11,9 @@ program lcobound_tests
logical non_integer, logical_coarray[3,*]
logical, parameter :: const_non_integer = .true.
integer, allocatable :: lcobounds(:)
real bounded[2:3,4:5,*]
integer(kind=merge(kind(1),-1,all(lcobound(bounded)==[2,4,1]))) test_lcobound
!___ standard-conforming statement with no optional arguments present ___
lcobounds = lcobound(scalar_coarray)
@ -50,28 +53,28 @@ program lcobound_tests
!___ non-conforming statements ___
!ERROR: DIM=0 dimension is out of range for coarray with corank 1
!ERROR: DIM=0 dimension must be positive
n = lcobound(scalar_coarray, dim=0)
!ERROR: DIM=0 dimension is out of range for coarray with corank 3
!ERROR: DIM=0 dimension must be positive
n = lcobound(coarray_corank3, dim=0)
!ERROR: DIM=-1 dimension is out of range for coarray with corank 1
!ERROR: DIM=-1 dimension must be positive
n = lcobound(scalar_coarray, dim=-1)
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
n = lcobound(array_coarray, dim=2)
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
n = lcobound(array_coarray, 2)
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
n = lcobound(coarray_corank3, dim=4)
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
n = lcobound(dim=4, coarray=coarray_corank3)
!ERROR: DIM=5 dimension is out of range for coarray with corank 3
!ERROR: DIM=5 dimension is out of range for corank-3 coarray
n = lcobound(coarray_corank3, const_out_of_range_dim)
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)

View File

@ -11,6 +11,9 @@ program ucobound_tests
logical non_integer, logical_coarray[3,*]
logical, parameter :: const_non_integer = .true.
integer, allocatable :: ucobounds(:)
real bounded[2:3,4:5,*]
integer(kind=merge(kind(1),-1,ucobound(bounded,1)==3.and.ucobound(bounded,2)==5)) test_ucobound
!___ standard-conforming statement with no optional arguments present ___
ucobounds = ucobound(scalar_coarray)
@ -50,28 +53,28 @@ program ucobound_tests
!___ non-conforming statements ___
!ERROR: DIM=0 dimension is out of range for coarray with corank 1
!ERROR: DIM=0 dimension must be positive
n = ucobound(scalar_coarray, dim=0)
!ERROR: DIM=0 dimension is out of range for coarray with corank 3
!ERROR: DIM=0 dimension must be positive
n = ucobound(coarray_corank3, dim=0)
!ERROR: DIM=-1 dimension is out of range for coarray with corank 1
!ERROR: DIM=-1 dimension must be positive
n = ucobound(scalar_coarray, dim=-1)
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
n = ucobound(array_coarray, dim=2)
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
n = ucobound(array_coarray, 2)
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
n = ucobound(coarray_corank3, dim=4)
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
n = ucobound(dim=4, coarray=coarray_corank3)
!ERROR: DIM=5 dimension is out of range for coarray with corank 3
!ERROR: DIM=5 dimension is out of range for corank-3 coarray
n = ucobound(coarray_corank3, const_out_of_range_dim)
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)