[flang-commits] [flang] efd7caa - [flang] IEEE_SUPPORT_FLAG(..., LOCAL) in specification expression (#134270)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 4 08:43:28 PDT 2025
Author: Peter Klausler
Date: 2025-04-04T08:43:25-07:00
New Revision: efd7caac2e60209fd9358a24f038c91afe6a4a0a
URL: https://github.com/llvm/llvm-project/commit/efd7caac2e60209fd9358a24f038c91afe6a4a0a
DIFF: https://github.com/llvm/llvm-project/commit/efd7caac2e60209fd9358a24f038c91afe6a4a0a.diff
LOG: [flang] IEEE_SUPPORT_FLAG(..., LOCAL) in specification expression (#134270)
The optional second argument to IEEE_SUPPORT_FLAG (and related functions
from the intrinsic IEEE_ARITHMETIC module) is needed only for its type,
not its value. Restrictions on local objects as arguments to function
references in specification expressions shouldn't apply to it.
Define a new attribute for dummy data object characteristics to
distinguish such arguments, set it for the appropriate intrinsic
function references, and test it during specification expression
validation.
Added:
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/test/Evaluate/errors01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 2fecb44fc0082..6d29b57889681 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -220,7 +220,7 @@ class TypeAndShape {
// 15.3.2.2
struct DummyDataObject {
ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
- Volatile, Pointer, Target, DeducedFromActual)
+ Volatile, Pointer, Target, DeducedFromActual, OnlyIntrinsicInquiry)
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
static bool IdenticalSignificantAttrs(const Attrs &x, const Attrs &y) {
return (x - Attr::DeducedFromActual) == (y - Attr::DeducedFromActual);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 3d338b04e64bb..4d272795ff9bd 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -133,13 +133,23 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
return shape && IsConstantExprShape(*shape);
} else if (proc.IsPure()) {
+ std::size_t j{0};
for (const auto &arg : call.arguments()) {
- if (!arg) {
+ if (const auto *dataDummy{j < proc.dummyArguments.size()
+ ? std::get_if<characteristics::DummyDataObject>(
+ &proc.dummyArguments[j].u)
+ : nullptr};
+ dataDummy &&
+ dataDummy->attrs.test(
+ characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry)) {
+ // The value of the argument doesn't matter
+ } else if (!arg) {
return false;
} else if (const auto *expr{arg->UnwrapExpr()};
- !expr || !(*this)(*expr)) {
+ !expr || !(*this)(*expr)) {
return false;
}
+ ++j;
}
return true;
}
@@ -647,7 +657,6 @@ class CheckSpecificationExprHelper
}
Result operator()(const ProcedureRef &x) const {
- bool inInquiry{false};
if (const auto *symbol{x.proc().GetSymbol()}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (!semantics::IsPureProcedure(ultimate)) {
@@ -679,10 +688,12 @@ class CheckSpecificationExprHelper
}
// References to internal functions are caught in expression semantics.
// TODO: other checks for standard module procedures
+ auto restorer{common::ScopedSet(inInquiry_, false)};
+ return (*this)(x.arguments());
} else { // intrinsic
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
- inInquiry = context_.intrinsics().GetIntrinsicClass(intrin.name) ==
- IntrinsicClass::inquiryFunction;
+ bool inInquiry{context_.intrinsics().GetIntrinsicClass(intrin.name) ==
+ IntrinsicClass::inquiryFunction};
if (scope_.IsDerivedType()) { // C750, C754
if ((context_.intrinsics().IsIntrinsic(intrin.name) &&
badIntrinsicsForComponents_.find(intrin.name) !=
@@ -709,37 +720,55 @@ class CheckSpecificationExprHelper
if (intrin.name == "present") {
return std::nullopt; // always ok
}
- // Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y
- if (inInquiry && x.arguments().size() >= 1) {
- if (const auto &arg{x.arguments().at(0)}) {
- if (auto dataRef{ExtractDataRef(*arg, true, true)}) {
- if (intrin.name == "allocated" || intrin.name == "associated" ||
- intrin.name == "is_contiguous") { // ok
- } else if (intrin.name == "len" &&
- IsPermissibleInquiry(dataRef->GetFirstSymbol(),
- dataRef->GetLastSymbol(),
- DescriptorInquiry::Field::Len)) { // ok
- } else if (intrin.name == "lbound" &&
- IsPermissibleInquiry(dataRef->GetFirstSymbol(),
- dataRef->GetLastSymbol(),
- DescriptorInquiry::Field::LowerBound)) { // ok
- } else if ((intrin.name == "shape" || intrin.name == "size" ||
- intrin.name == "sizeof" ||
- intrin.name == "storage_size" ||
- intrin.name == "ubound") &&
- IsPermissibleInquiry(dataRef->GetFirstSymbol(),
- dataRef->GetLastSymbol(),
- DescriptorInquiry::Field::Extent)) { // ok
- } else {
- return "non-constant inquiry function '"s + intrin.name +
- "' not allowed for local object";
+ const auto &proc{intrin.characteristics.value()};
+ std::size_t j{0};
+ for (const auto &arg : x.arguments()) {
+ bool checkArg{true};
+ if (const auto *dataDummy{j < proc.dummyArguments.size()
+ ? std::get_if<characteristics::DummyDataObject>(
+ &proc.dummyArguments[j].u)
+ : nullptr}) {
+ if (dataDummy->attrs.test(characteristics::DummyDataObject::Attr::
+ OnlyIntrinsicInquiry)) {
+ checkArg = false; // value unused, e.g. IEEE_SUPPORT_FLAG(,,,. X)
+ }
+ }
+ if (arg && checkArg) {
+ // Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y
+ if (inInquiry) {
+ if (auto dataRef{ExtractDataRef(*arg, true, true)}) {
+ if (intrin.name == "allocated" || intrin.name == "associated" ||
+ intrin.name == "is_contiguous") { // ok
+ } else if (intrin.name == "len" &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::Len)) { // ok
+ } else if (intrin.name == "lbound" &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::LowerBound)) { // ok
+ } else if ((intrin.name == "shape" || intrin.name == "size" ||
+ intrin.name == "sizeof" ||
+ intrin.name == "storage_size" ||
+ intrin.name == "ubound") &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::Extent)) { // ok
+ } else {
+ return "non-constant inquiry function '"s + intrin.name +
+ "' not allowed for local object";
+ }
}
}
+ auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
+ if (auto err{(*this)(*arg)}) {
+ return err;
+ }
}
+ ++j;
}
+ return std::nullopt;
}
- auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
- return (*this)(x.arguments());
}
private:
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index ed90b4bc097dd..997a745466dea 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -256,7 +256,8 @@ ENUM_CLASS(ArgFlag, none,
defaultsToSameKind, // for MatchingDefaultKIND
defaultsToSizeKind, // for SizeDefaultKIND
defaultsToDefaultForResult, // for DefaultingKIND
- notAssumedSize)
+ notAssumedSize,
+ onlyConstantInquiry) // e.g., PRECISION(X)
struct IntrinsicDummyArgument {
const char *keyword{nullptr};
@@ -398,7 +399,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
DefaultLogical},
{"bit_size",
{{"i", SameIntOrUnsigned, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
SameInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"ble",
{{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
@@ -439,7 +441,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"digits",
{{"x", AnyIntUnsignedOrReal, Rank::anyOrAssumedRank,
Optionality::required, common::Intent::In,
- {ArgFlag::canBeMoldNull}}},
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"dim", {{"x", OperandIntOrReal}, {"y", OperandIntOrReal}},
OperandIntOrReal},
@@ -485,7 +487,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
IntrinsicClass::transformationalFunction},
{"epsilon",
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"erf", {{"x", SameReal}}, SameReal},
{"erfc", {{"x", SameReal}}, SameReal},
@@ -568,7 +571,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"huge",
{{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
Optionality::required, common::Intent::In,
- {ArgFlag::canBeMoldNull}}},
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
SameIntUnsignedOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
@@ -656,7 +659,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"jzext", {{"i", AnyInt}}, DefaultInt},
{"kind",
{{"x", AnyIntrinsic, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::elemental, IntrinsicClass::inquiryFunction},
{"lbound",
{{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
@@ -730,7 +734,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameCharNoLen},
{"maxexponent",
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"maxloc",
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -775,7 +780,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameCharNoLen},
{"minexponent",
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"minloc",
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -804,7 +810,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
{"new_line",
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
SameCharNoLen, Rank::scalar, IntrinsicClass::inquiryFunction},
{"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
{"norm2", {{"x", SameReal, Rank::array}, RequiredDIM}, SameReal,
@@ -844,21 +851,25 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
{"precision",
{{"x", AnyFloating, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"present", {{"a", Addressable, Rank::anyOrAssumedRank}}, DefaultLogical,
Rank::scalar, IntrinsicClass::inquiryFunction},
{"radix",
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"range",
{{"x", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"rank",
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"real", {{"a", SameComplex, Rank::elemental}},
SameReal}, // 16.9.160(4)(ii)
@@ -987,7 +998,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
IntrinsicClass::transformationalFunction},
{"tiny",
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"trailz", {{"i", AnyInt}}, DefaultInt},
{"transfer",
@@ -1044,35 +1056,59 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"__builtin_ieee_next_up", {{"x", SameReal}}, SameReal},
{"__builtin_ieee_real", {{"a", AnyIntOrReal}, DefaultingKIND}, KINDReal},
{"__builtin_ieee_support_datatype",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_denormal",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_divide",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_flag",
{{"flag", IeeeFlagType, Rank::scalar},
- {"x", AnyReal, Rank::known, Optionality::optional}},
+ {"x", AnyReal, Rank::known, Optionality::optional,
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultLogical},
{"__builtin_ieee_support_halting", {{"flag", IeeeFlagType, Rank::scalar}},
DefaultLogical},
{"__builtin_ieee_support_inf",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_io",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_nan",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_rounding",
{{"round_value", IeeeRoundType, Rank::scalar},
- {"x", AnyReal, Rank::known, Optionality::optional}},
+ {"x", AnyReal, Rank::known, Optionality::optional,
+ common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
DefaultLogical},
{"__builtin_ieee_support_sqrt",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_standard",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_subnormal",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_ieee_support_underflow_control",
- {{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
+ {{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
+ {ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
+ DefaultLogical},
{"__builtin_numeric_storage_size", {}, DefaultInt},
};
@@ -2671,6 +2707,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
std::get_if<characteristics::DummyDataObject>(
&dc->u)}) {
dummyObject->type.set_corank(0);
+ if (d.flags.test(ArgFlag::onlyConstantInquiry)) {
+ dummyObject->attrs.set(
+ characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry);
+ }
}
dummyArgs.emplace_back(std::move(*dc));
if (d.typePattern.kindCode == KindCode::same && !sameDummyArg) {
diff --git a/flang/test/Evaluate/errors01.f90 b/flang/test/Evaluate/errors01.f90
index 283c246393dcd..b20922237f240 100644
--- a/flang/test/Evaluate/errors01.f90
+++ b/flang/test/Evaluate/errors01.f90
@@ -167,6 +167,14 @@ subroutine s14(n)
!CHECK: error: IBITS() must have POS+LEN (>=33) no greater than 32
print *, ibits(0, 33, n)
end
+ subroutine s15
+ use ieee_arithmetic, only: ieee_flag_type, ieee_underflow, ieee_support_flag
+ type(ieee_flag_type) :: f1 = ieee_underflow, f2
+ !CHECK: portability: specification expression refers to local object 'f1' (initialized and saved)
+ integer ok(merge(kind(1),-1,ieee_support_flag(f1, x)))
+ !CHECK: error: Invalid specification expression: reference to local entity 'f2'
+ integer bad(merge(kind(1),-1,ieee_support_flag(f2, x)))
+ end
subroutine warnings
use ieee_arithmetic, only: ieee_scalb
real, parameter :: ok1 = scale(0.0, 99999) ! 0.0
More information about the flang-commits
mailing list