Skip to content

Commit 9496391

Browse files
klauslerklausler
authored
[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.
1 parent d1ea605 commit 9496391

File tree

6 files changed

+139
-41
lines changed

6 files changed

+139
-41
lines changed

‎flang/include/flang/Evaluate/shape.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,14 @@ MaybeExtentExpr GetExtent(const Subscript &, const NamedEntity &, int dimension,
117117
MaybeExtentExpr GetExtent(FoldingContext &, const Subscript &,
118118
const NamedEntity &, int dimension, bool invariantOnly = true);
119119

120+
// Similar analyses for coarrays
121+
MaybeExtentExpr GetLCOBOUND(
122+
const Symbol &, int dimension, bool invariantOnly = true);
123+
MaybeExtentExpr GetUCOBOUND(
124+
const Symbol &, int dimension, bool invariantOnly = true);
125+
Shape GetLCOBOUNDs(const Symbol &, bool invariantOnly = true);
126+
Shape GetUCOBOUNDs(const Symbol &, bool invariantOnly = true);
127+
120128
// Compute an element count for a triplet or trip count for a DO.
121129
ExtentExpr CountTrips(
122130
ExtentExpr &&lower, ExtentExpr &&upper, ExtentExpr &&stride);

‎flang/lib/Evaluate/fold-integer.cpp

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,28 @@ static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
7171
return true;
7272
}
7373

74+
static bool CheckCoDimArg(const std::optional<ActualArgument> &dimArg,
75+
const Symbol &symbol, parser::ContextualMessages &messages,
76+
std::optional<int> &dimVal) {
77+
dimVal.reset();
78+
if (int corank{symbol.Corank()}; corank > 0) {
79+
if (auto dim64{ToInt64(dimArg)}) {
80+
if (*dim64 < 1) {
81+
messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
82+
return false;
83+
} else if (*dim64 > corank) {
84+
messages.Say(
85+
"DIM=%jd dimension is out of range for corank-%d coarray"_err_en_US,
86+
*dim64, corank);
87+
return false;
88+
} else {
89+
dimVal = static_cast<int>(*dim64 - 1); // 1-based to 0-based
90+
}
91+
}
92+
}
93+
return true;
94+
}
95+
7496
// Class to retrieve the constant bound of an expression which is an
7597
// array that devolves to a type of Constant<T>
7698
class GetConstantArrayBoundHelper {
@@ -264,6 +286,37 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
264286
return Expr<T>{std::move(funcRef)};
265287
}
266288

289+
// LCOBOUND() & UCOBOUND()
290+
template <int KIND>
291+
Expr<Type<TypeCategory::Integer, KIND>> COBOUND(FoldingContext &context,
292+
FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef, bool isUCOBOUND) {
293+
using T = Type<TypeCategory::Integer, KIND>;
294+
ActualArguments &args{funcRef.arguments()};
295+
if (const Symbol * coarray{UnwrapWholeSymbolOrComponentDataRef(args[0])}) {
296+
std::optional<int> dim;
297+
if (funcRef.Rank() == 0) {
298+
// Optional DIM= argument is present: result is scalar.
299+
if (!CheckCoDimArg(args[1], *coarray, context.messages(), dim)) {
300+
return MakeInvalidIntrinsic<T>(std::move(funcRef));
301+
} else if (!dim) {
302+
// DIM= is present but not constant, or error
303+
return Expr<T>{std::move(funcRef)};
304+
}
305+
}
306+
if (dim) {
307+
if (auto cb{isUCOBOUND ? GetUCOBOUND(*coarray, *dim)
308+
: GetLCOBOUND(*coarray, *dim)}) {
309+
return Fold(context, ConvertToType<T>(std::move(*cb)));
310+
}
311+
} else if (auto cbs{
312+
AsExtentArrayExpr(isUCOBOUND ? GetUCOBOUNDs(*coarray)
313+
: GetLCOBOUNDs(*coarray))}) {
314+
return Fold(context, ConvertToType<T>(Expr<ExtentType>{std::move(*cbs)}));
315+
}
316+
}
317+
return Expr<T>{std::move(funcRef)};
318+
}
319+
267320
// COUNT()
268321
template <typename T, int MASK_KIND> class CountAccumulator {
269322
using MaskT = Type<TypeCategory::Logical, MASK_KIND>;
@@ -1105,6 +1158,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
11051158
}
11061159
} else if (name == "lbound") {
11071160
return LBOUND(context, std::move(funcRef));
1161+
} else if (name == "lcobound") {
1162+
return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/false);
11081163
} else if (name == "leadz" || name == "trailz" || name == "poppar" ||
11091164
name == "popcnt") {
11101165
if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
@@ -1396,6 +1451,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
13961451
}
13971452
} else if (name == "ubound") {
13981453
return UBOUND(context, std::move(funcRef));
1454+
} else if (name == "ucobound") {
1455+
return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/true);
13991456
} else if (name == "__builtin_numeric_storage_size") {
14001457
if (!context.moduleFileName()) {
14011458
// Don't fold this reference until it appears in the module file

‎flang/lib/Evaluate/intrinsics.cpp

Lines changed: 0 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -3189,27 +3189,6 @@ static bool CheckForNonPositiveValues(FoldingContext &context,
31893189
return ok;
31903190
}
31913191

3192-
static bool CheckDimAgainstCorank(SpecificCall &call, FoldingContext &context) {
3193-
bool ok{true};
3194-
if (const auto &coarrayArg{call.arguments[0]}) {
3195-
if (const auto &dimArg{call.arguments[1]}) {
3196-
if (const auto *symbol{
3197-
UnwrapWholeSymbolDataRef(coarrayArg->UnwrapExpr())}) {
3198-
const auto corank = symbol->Corank();
3199-
if (const auto dimNum{ToInt64(dimArg->UnwrapExpr())}) {
3200-
if (dimNum < 1 || dimNum > corank) {
3201-
ok = false;
3202-
context.messages().Say(dimArg->sourceLocation(),
3203-
"DIM=%jd dimension is out of range for coarray with corank %d"_err_en_US,
3204-
static_cast<std::intmax_t>(*dimNum), corank);
3205-
}
3206-
}
3207-
}
3208-
}
3209-
}
3210-
return ok;
3211-
}
3212-
32133192
static bool CheckAtomicDefineAndRef(FoldingContext &context,
32143193
const std::optional<ActualArgument> &atomArg,
32153194
const std::optional<ActualArgument> &valueArg,
@@ -3277,8 +3256,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
32773256
if (const auto &arg{call.arguments[0]}) {
32783257
ok = CheckForNonPositiveValues(context, *arg, name, "image");
32793258
}
3280-
} else if (name == "lcobound") {
3281-
return CheckDimAgainstCorank(call, context);
32823259
} else if (name == "loc") {
32833260
const auto &arg{call.arguments[0]};
32843261
ok =
@@ -3288,8 +3265,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
32883265
arg ? arg->sourceLocation() : context.messages().at(),
32893266
"Argument of LOC() must be an object or procedure"_err_en_US);
32903267
}
3291-
} else if (name == "ucobound") {
3292-
return CheckDimAgainstCorank(call, context);
32933268
}
32943269
return ok;
32953270
}

‎flang/lib/Evaluate/shape.cpp

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -723,6 +723,58 @@ Shape GetUBOUNDs(const NamedEntity &base, bool invariantOnly) {
723723
return GetUBOUNDs(nullptr, base, invariantOnly);
724724
}
725725

726+
MaybeExtentExpr GetLCOBOUND(
727+
const Symbol &symbol0, int dimension, bool invariantOnly) {
728+
const Symbol &symbol{ResolveAssociations(symbol0)};
729+
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
730+
int corank{object->coshape().Rank()};
731+
if (dimension < corank) {
732+
const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
733+
if (const auto &lcobound{shapeSpec.lbound().GetExplicit()}) {
734+
if (!invariantOnly || IsScopeInvariantExpr(*lcobound)) {
735+
return *lcobound;
736+
}
737+
}
738+
}
739+
}
740+
return std::nullopt;
741+
}
742+
743+
MaybeExtentExpr GetUCOBOUND(
744+
const Symbol &symbol0, int dimension, bool invariantOnly) {
745+
const Symbol &symbol{ResolveAssociations(symbol0)};
746+
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
747+
int corank{object->coshape().Rank()};
748+
if (dimension < corank - 1) {
749+
const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
750+
if (const auto ucobound{shapeSpec.ubound().GetExplicit()}) {
751+
if (!invariantOnly || IsScopeInvariantExpr(*ucobound)) {
752+
return *ucobound;
753+
}
754+
}
755+
}
756+
}
757+
return std::nullopt;
758+
}
759+
760+
Shape GetLCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
761+
Shape result;
762+
int corank{symbol.Corank()};
763+
for (int dim{0}; dim < corank; ++dim) {
764+
result.emplace_back(GetLCOBOUND(symbol, dim, invariantOnly));
765+
}
766+
return result;
767+
}
768+
769+
Shape GetUCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
770+
Shape result;
771+
int corank{symbol.Corank()};
772+
for (int dim{0}; dim < corank; ++dim) {
773+
result.emplace_back(GetUCOBOUND(symbol, dim, invariantOnly));
774+
}
775+
return result;
776+
}
777+
726778
auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
727779
return common::visit(
728780
common::visitors{

‎flang/test/Semantics/lcobound.f90

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,9 @@ program lcobound_tests
1111
logical non_integer, logical_coarray[3,*]
1212
logical, parameter :: const_non_integer = .true.
1313
integer, allocatable :: lcobounds(:)
14+
real bounded[2:3,4:5,*]
15+
16+
integer(kind=merge(kind(1),-1,all(lcobound(bounded)==[2,4,1]))) test_lcobound
1417

1518
!___ standard-conforming statement with no optional arguments present ___
1619
lcobounds = lcobound(scalar_coarray)
@@ -50,28 +53,28 @@ program lcobound_tests
5053

5154
!___ non-conforming statements ___
5255

53-
!ERROR: DIM=0 dimension is out of range for coarray with corank 1
56+
!ERROR: DIM=0 dimension must be positive
5457
n = lcobound(scalar_coarray, dim=0)
5558

56-
!ERROR: DIM=0 dimension is out of range for coarray with corank 3
59+
!ERROR: DIM=0 dimension must be positive
5760
n = lcobound(coarray_corank3, dim=0)
5861

59-
!ERROR: DIM=-1 dimension is out of range for coarray with corank 1
62+
!ERROR: DIM=-1 dimension must be positive
6063
n = lcobound(scalar_coarray, dim=-1)
6164

62-
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
65+
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
6366
n = lcobound(array_coarray, dim=2)
6467

65-
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
68+
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
6669
n = lcobound(array_coarray, 2)
6770

68-
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
71+
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
6972
n = lcobound(coarray_corank3, dim=4)
7073

71-
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
74+
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
7275
n = lcobound(dim=4, coarray=coarray_corank3)
7376

74-
!ERROR: DIM=5 dimension is out of range for coarray with corank 3
77+
!ERROR: DIM=5 dimension is out of range for corank-3 coarray
7578
n = lcobound(coarray_corank3, const_out_of_range_dim)
7679

7780
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)

‎flang/test/Semantics/ucobound.f90

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,9 @@ program ucobound_tests
1111
logical non_integer, logical_coarray[3,*]
1212
logical, parameter :: const_non_integer = .true.
1313
integer, allocatable :: ucobounds(:)
14+
real bounded[2:3,4:5,*]
15+
16+
integer(kind=merge(kind(1),-1,ucobound(bounded,1)==3.and.ucobound(bounded,2)==5)) test_ucobound
1417

1518
!___ standard-conforming statement with no optional arguments present ___
1619
ucobounds = ucobound(scalar_coarray)
@@ -50,28 +53,28 @@ program ucobound_tests
5053

5154
!___ non-conforming statements ___
5255

53-
!ERROR: DIM=0 dimension is out of range for coarray with corank 1
56+
!ERROR: DIM=0 dimension must be positive
5457
n = ucobound(scalar_coarray, dim=0)
5558

56-
!ERROR: DIM=0 dimension is out of range for coarray with corank 3
59+
!ERROR: DIM=0 dimension must be positive
5760
n = ucobound(coarray_corank3, dim=0)
5861

59-
!ERROR: DIM=-1 dimension is out of range for coarray with corank 1
62+
!ERROR: DIM=-1 dimension must be positive
6063
n = ucobound(scalar_coarray, dim=-1)
6164

62-
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
65+
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
6366
n = ucobound(array_coarray, dim=2)
6467

65-
!ERROR: DIM=2 dimension is out of range for coarray with corank 1
68+
!ERROR: DIM=2 dimension is out of range for corank-1 coarray
6669
n = ucobound(array_coarray, 2)
6770

68-
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
71+
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
6972
n = ucobound(coarray_corank3, dim=4)
7073

71-
!ERROR: DIM=4 dimension is out of range for coarray with corank 3
74+
!ERROR: DIM=4 dimension is out of range for corank-3 coarray
7275
n = ucobound(dim=4, coarray=coarray_corank3)
7376

74-
!ERROR: DIM=5 dimension is out of range for coarray with corank 3
77+
!ERROR: DIM=5 dimension is out of range for corank-3 coarray
7578
n = ucobound(coarray_corank3, const_out_of_range_dim)
7679

7780
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)

0 commit comments

Comments
 (0)