Skip to content

Commit efd7caa

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

File tree

4 files changed

+135
-58
lines changed

4 files changed

+135
-58
lines changed

‎flang/include/flang/Evaluate/characteristics.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -220,7 +220,7 @@ class TypeAndShape {
220220
// 15.3.2.2
221221
struct DummyDataObject {
222222
ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
223-
Volatile, Pointer, Target, DeducedFromActual)
223+
Volatile, Pointer, Target, DeducedFromActual, OnlyIntrinsicInquiry)
224224
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
225225
static bool IdenticalSignificantAttrs(const Attrs &x, const Attrs &y) {
226226
return (x - Attr::DeducedFromActual) == (y - Attr::DeducedFromActual);

‎flang/lib/Evaluate/check-expression.cpp‎

Lines changed: 60 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -133,13 +133,23 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
133133
auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
134134
return shape && IsConstantExprShape(*shape);
135135
} else if (proc.IsPure()) {
136+
std::size_t j{0};
136137
for (const auto &arg : call.arguments()) {
137-
if (!arg) {
138+
if (const auto *dataDummy{j < proc.dummyArguments.size()
139+
? std::get_if<characteristics::DummyDataObject>(
140+
&proc.dummyArguments[j].u)
141+
: nullptr};
142+
dataDummy &&
143+
dataDummy->attrs.test(
144+
characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry)) {
145+
// The value of the argument doesn't matter
146+
} else if (!arg) {
138147
return false;
139148
} else if (const auto *expr{arg->UnwrapExpr()};
140-
!expr || !(*this)(*expr)) {
149+
!expr || !(*this)(*expr)) {
141150
return false;
142151
}
152+
++j;
143153
}
144154
return true;
145155
}
@@ -647,7 +657,6 @@ class CheckSpecificationExprHelper
647657
}
648658

649659
Result operator()(const ProcedureRef &x) const {
650-
bool inInquiry{false};
651660
if (const auto *symbol{x.proc().GetSymbol()}) {
652661
const Symbol &ultimate{symbol->GetUltimate()};
653662
if (!semantics::IsPureProcedure(ultimate)) {
@@ -679,10 +688,12 @@ class CheckSpecificationExprHelper
679688
}
680689
// References to internal functions are caught in expression semantics.
681690
// TODO: other checks for standard module procedures
691+
auto restorer{common::ScopedSet(inInquiry_, false)};
692+
return (*this)(x.arguments());
682693
} else { // intrinsic
683694
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
684-
inInquiry = context_.intrinsics().GetIntrinsicClass(intrin.name) ==
685-
IntrinsicClass::inquiryFunction;
695+
bool inInquiry{context_.intrinsics().GetIntrinsicClass(intrin.name) ==
696+
IntrinsicClass::inquiryFunction};
686697
if (scope_.IsDerivedType()) { // C750, C754
687698
if ((context_.intrinsics().IsIntrinsic(intrin.name) &&
688699
badIntrinsicsForComponents_.find(intrin.name) !=
@@ -709,37 +720,55 @@ class CheckSpecificationExprHelper
709720
if (intrin.name == "present") {
710721
return std::nullopt; // always ok
711722
}
712-
// Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y
713-
if (inInquiry && x.arguments().size() >= 1) {
714-
if (const auto &arg{x.arguments().at(0)}) {
715-
if (auto dataRef{ExtractDataRef(*arg, true, true)}) {
716-
if (intrin.name == "allocated" || intrin.name == "associated" ||
717-
intrin.name == "is_contiguous") { // ok
718-
} else if (intrin.name == "len" &&
719-
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
720-
dataRef->GetLastSymbol(),
721-
DescriptorInquiry::Field::Len)) { // ok
722-
} else if (intrin.name == "lbound" &&
723-
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
724-
dataRef->GetLastSymbol(),
725-
DescriptorInquiry::Field::LowerBound)) { // ok
726-
} else if ((intrin.name == "shape" || intrin.name == "size" ||
727-
intrin.name == "sizeof" ||
728-
intrin.name == "storage_size" ||
729-
intrin.name == "ubound") &&
730-
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
731-
dataRef->GetLastSymbol(),
732-
DescriptorInquiry::Field::Extent)) { // ok
733-
} else {
734-
return "non-constant inquiry function '"s + intrin.name +
735-
"' not allowed for local object";
723+
const auto &proc{intrin.characteristics.value()};
724+
std::size_t j{0};
725+
for (const auto &arg : x.arguments()) {
726+
bool checkArg{true};
727+
if (const auto *dataDummy{j < proc.dummyArguments.size()
728+
? std::get_if<characteristics::DummyDataObject>(
729+
&proc.dummyArguments[j].u)
730+
: nullptr}) {
731+
if (dataDummy->attrs.test(characteristics::DummyDataObject::Attr::
732+
OnlyIntrinsicInquiry)) {
733+
checkArg = false; // value unused, e.g. IEEE_SUPPORT_FLAG(,,,. X)
734+
}
735+
}
736+
if (arg && checkArg) {
737+
// Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y
738+
if (inInquiry) {
739+
if (auto dataRef{ExtractDataRef(*arg, true, true)}) {
740+
if (intrin.name == "allocated" || intrin.name == "associated" ||
741+
intrin.name == "is_contiguous") { // ok
742+
} else if (intrin.name == "len" &&
743+
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
744+
dataRef->GetLastSymbol(),
745+
DescriptorInquiry::Field::Len)) { // ok
746+
} else if (intrin.name == "lbound" &&
747+
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
748+
dataRef->GetLastSymbol(),
749+
DescriptorInquiry::Field::LowerBound)) { // ok
750+
} else if ((intrin.name == "shape" || intrin.name == "size" ||
751+
intrin.name == "sizeof" ||
752+
intrin.name == "storage_size" ||
753+
intrin.name == "ubound") &&
754+
IsPermissibleInquiry(dataRef->GetFirstSymbol(),
755+
dataRef->GetLastSymbol(),
756+
DescriptorInquiry::Field::Extent)) { // ok
757+
} else {
758+
return "non-constant inquiry function '"s + intrin.name +
759+
"' not allowed for local object";
760+
}
736761
}
737762
}
763+
auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
764+
if (auto err{(*this)(*arg)}) {
765+
return err;
766+
}
738767
}
768+
++j;
739769
}
770+
return std::nullopt;
740771
}
741-
auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
742-
return (*this)(x.arguments());
743772
}
744773

745774
private:

‎flang/lib/Evaluate/intrinsics.cpp‎

Lines changed: 66 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -256,7 +256,8 @@ ENUM_CLASS(ArgFlag, none,
256256
defaultsToSameKind, // for MatchingDefaultKIND
257257
defaultsToSizeKind, // for SizeDefaultKIND
258258
defaultsToDefaultForResult, // for DefaultingKIND
259-
notAssumedSize)
259+
notAssumedSize,
260+
onlyConstantInquiry) // e.g., PRECISION(X)
260261

261262
struct IntrinsicDummyArgument {
262263
const char *keyword{nullptr};
@@ -398,7 +399,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
398399
DefaultLogical},
399400
{"bit_size",
400401
{{"i", SameIntOrUnsigned, Rank::anyOrAssumedRank, Optionality::required,
401-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
402+
common::Intent::In,
403+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
402404
SameInt, Rank::scalar, IntrinsicClass::inquiryFunction},
403405
{"ble",
404406
{{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
@@ -439,7 +441,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
439441
{"digits",
440442
{{"x", AnyIntUnsignedOrReal, Rank::anyOrAssumedRank,
441443
Optionality::required, common::Intent::In,
442-
{ArgFlag::canBeMoldNull}}},
444+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
443445
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
444446
{"dim", {{"x", OperandIntOrReal}, {"y", OperandIntOrReal}},
445447
OperandIntOrReal},
@@ -485,7 +487,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
485487
IntrinsicClass::transformationalFunction},
486488
{"epsilon",
487489
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
488-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
490+
common::Intent::In,
491+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
489492
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
490493
{"erf", {{"x", SameReal}}, SameReal},
491494
{"erfc", {{"x", SameReal}}, SameReal},
@@ -568,7 +571,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
568571
{"huge",
569572
{{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
570573
Optionality::required, common::Intent::In,
571-
{ArgFlag::canBeMoldNull}}},
574+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
572575
SameIntUnsignedOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
573576
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
574577
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
@@ -656,7 +659,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
656659
{"jzext", {{"i", AnyInt}}, DefaultInt},
657660
{"kind",
658661
{{"x", AnyIntrinsic, Rank::anyOrAssumedRank, Optionality::required,
659-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
662+
common::Intent::In,
663+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
660664
DefaultInt, Rank::elemental, IntrinsicClass::inquiryFunction},
661665
{"lbound",
662666
{{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
@@ -730,7 +734,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
730734
SameCharNoLen},
731735
{"maxexponent",
732736
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
733-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
737+
common::Intent::In,
738+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
734739
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
735740
{"maxloc",
736741
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -775,7 +780,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
775780
SameCharNoLen},
776781
{"minexponent",
777782
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
778-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
783+
common::Intent::In,
784+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
779785
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
780786
{"minloc",
781787
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -804,7 +810,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
804810
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
805811
{"new_line",
806812
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
807-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
813+
common::Intent::In,
814+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
808815
SameCharNoLen, Rank::scalar, IntrinsicClass::inquiryFunction},
809816
{"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
810817
{"norm2", {{"x", SameReal, Rank::array}, RequiredDIM}, SameReal,
@@ -844,21 +851,25 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
844851
SameNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
845852
{"precision",
846853
{{"x", AnyFloating, Rank::anyOrAssumedRank, Optionality::required,
847-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
854+
common::Intent::In,
855+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
848856
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
849857
{"present", {{"a", Addressable, Rank::anyOrAssumedRank}}, DefaultLogical,
850858
Rank::scalar, IntrinsicClass::inquiryFunction},
851859
{"radix",
852860
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
853-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
861+
common::Intent::In,
862+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
854863
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
855864
{"range",
856865
{{"x", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
857-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
866+
common::Intent::In,
867+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
858868
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
859869
{"rank",
860870
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
861-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
871+
common::Intent::In,
872+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
862873
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
863874
{"real", {{"a", SameComplex, Rank::elemental}},
864875
SameReal}, // 16.9.160(4)(ii)
@@ -987,7 +998,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
987998
IntrinsicClass::transformationalFunction},
988999
{"tiny",
9891000
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
990-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
1001+
common::Intent::In,
1002+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
9911003
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
9921004
{"trailz", {{"i", AnyInt}}, DefaultInt},
9931005
{"transfer",
@@ -1044,35 +1056,59 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
10441056
{"__builtin_ieee_next_up", {{"x", SameReal}}, SameReal},
10451057
{"__builtin_ieee_real", {{"a", AnyIntOrReal}, DefaultingKIND}, KINDReal},
10461058
{"__builtin_ieee_support_datatype",
1047-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1059+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1060+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1061+
DefaultLogical},
10481062
{"__builtin_ieee_support_denormal",
1049-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1063+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1064+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1065+
DefaultLogical},
10501066
{"__builtin_ieee_support_divide",
1051-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1067+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1068+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1069+
DefaultLogical},
10521070
{"__builtin_ieee_support_flag",
10531071
{{"flag", IeeeFlagType, Rank::scalar},
1054-
{"x", AnyReal, Rank::known, Optionality::optional}},
1072+
{"x", AnyReal, Rank::known, Optionality::optional,
1073+
common::Intent::In,
1074+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
10551075
DefaultLogical},
10561076
{"__builtin_ieee_support_halting", {{"flag", IeeeFlagType, Rank::scalar}},
10571077
DefaultLogical},
10581078
{"__builtin_ieee_support_inf",
1059-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1079+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1080+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1081+
DefaultLogical},
10601082
{"__builtin_ieee_support_io",
1061-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1083+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1084+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1085+
DefaultLogical},
10621086
{"__builtin_ieee_support_nan",
1063-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1087+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1088+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1089+
DefaultLogical},
10641090
{"__builtin_ieee_support_rounding",
10651091
{{"round_value", IeeeRoundType, Rank::scalar},
1066-
{"x", AnyReal, Rank::known, Optionality::optional}},
1092+
{"x", AnyReal, Rank::known, Optionality::optional,
1093+
common::Intent::In,
1094+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
10671095
DefaultLogical},
10681096
{"__builtin_ieee_support_sqrt",
1069-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1097+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1098+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1099+
DefaultLogical},
10701100
{"__builtin_ieee_support_standard",
1071-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1101+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1102+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1103+
DefaultLogical},
10721104
{"__builtin_ieee_support_subnormal",
1073-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1105+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1106+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1107+
DefaultLogical},
10741108
{"__builtin_ieee_support_underflow_control",
1075-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1109+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1110+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1111+
DefaultLogical},
10761112
{"__builtin_numeric_storage_size", {}, DefaultInt},
10771113
};
10781114

@@ -2671,6 +2707,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
26712707
std::get_if<characteristics::DummyDataObject>(
26722708
&dc->u)}) {
26732709
dummyObject->type.set_corank(0);
2710+
if (d.flags.test(ArgFlag::onlyConstantInquiry)) {
2711+
dummyObject->attrs.set(
2712+
characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry);
2713+
}
26742714
}
26752715
dummyArgs.emplace_back(std::move(*dc));
26762716
if (d.typePattern.kindCode == KindCode::same && !sameDummyArg) {

‎flang/test/Evaluate/errors01.f90‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,14 @@ subroutine s14(n)
167167
!CHECK: error: IBITS() must have POS+LEN (>=33) no greater than 32
168168
print *, ibits(0, 33, n)
169169
end
170+
subroutine s15
171+
use ieee_arithmetic, only: ieee_flag_type, ieee_underflow, ieee_support_flag
172+
type(ieee_flag_type) :: f1 = ieee_underflow, f2
173+
!CHECK: portability: specification expression refers to local object 'f1' (initialized and saved)
174+
integer ok(merge(kind(1),-1,ieee_support_flag(f1, x)))
175+
!CHECK: error: Invalid specification expression: reference to local entity 'f2'
176+
integer bad(merge(kind(1),-1,ieee_support_flag(f2, x)))
177+
end
170178
subroutine warnings
171179
use ieee_arithmetic, only: ieee_scalb
172180
real, parameter :: ok1 = scale(0.0, 99999) ! 0.0

0 commit comments

Comments
 (0)