Skip to content

Commit 6dafa68

Browse files
klauslerklausler
committed
[flang] IEEE_SUPPORT_FLAG(..., LOCAL) in specification expression
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 1407f5b commit 6dafa68

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},
@@ -562,7 +565,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
562565
{"huge",
563566
{{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
564567
Optionality::required, common::Intent::In,
565-
{ArgFlag::canBeMoldNull}}},
568+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
566569
SameIntUnsignedOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
567570
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
568571
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
@@ -650,7 +653,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
650653
{"jzext", {{"i", AnyInt}}, DefaultInt},
651654
{"kind",
652655
{{"x", AnyIntrinsic, Rank::anyOrAssumedRank, Optionality::required,
653-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
656+
common::Intent::In,
657+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
654658
DefaultInt, Rank::elemental, IntrinsicClass::inquiryFunction},
655659
{"lbound",
656660
{{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
@@ -724,7 +728,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
724728
SameCharNoLen},
725729
{"maxexponent",
726730
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
727-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
731+
common::Intent::In,
732+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
728733
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
729734
{"maxloc",
730735
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -769,7 +774,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
769774
SameCharNoLen},
770775
{"minexponent",
771776
{{"x", AnyReal, Rank::anyOrAssumedRank, Optionality::required,
772-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
777+
common::Intent::In,
778+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
773779
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
774780
{"minloc",
775781
{{"array", AnyRelatable, Rank::array}, RequiredDIM, OptionalMASK,
@@ -798,7 +804,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
798804
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
799805
{"new_line",
800806
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
801-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
807+
common::Intent::In,
808+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
802809
SameCharNoLen, Rank::scalar, IntrinsicClass::inquiryFunction},
803810
{"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
804811
{"norm2", {{"x", SameReal, Rank::array}, RequiredDIM}, SameReal,
@@ -838,21 +845,25 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
838845
SameNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
839846
{"precision",
840847
{{"x", AnyFloating, Rank::anyOrAssumedRank, Optionality::required,
841-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
848+
common::Intent::In,
849+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
842850
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
843851
{"present", {{"a", Addressable, Rank::anyOrAssumedRank}}, DefaultLogical,
844852
Rank::scalar, IntrinsicClass::inquiryFunction},
845853
{"radix",
846854
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
847-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
855+
common::Intent::In,
856+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
848857
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
849858
{"range",
850859
{{"x", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
851-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
860+
common::Intent::In,
861+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
852862
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
853863
{"rank",
854864
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
855-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
865+
common::Intent::In,
866+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
856867
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
857868
{"real", {{"a", SameComplex, Rank::elemental}},
858869
SameReal}, // 16.9.160(4)(ii)
@@ -979,7 +990,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
979990
IntrinsicClass::transformationalFunction},
980991
{"tiny",
981992
{{"x", SameReal, Rank::anyOrAssumedRank, Optionality::required,
982-
common::Intent::In, {ArgFlag::canBeMoldNull}}},
993+
common::Intent::In,
994+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
983995
SameReal, Rank::scalar, IntrinsicClass::inquiryFunction},
984996
{"trailz", {{"i", AnyInt}}, DefaultInt},
985997
{"transfer",
@@ -1034,35 +1046,59 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
10341046
{"__builtin_ieee_next_up", {{"x", SameReal}}, SameReal},
10351047
{"__builtin_ieee_real", {{"a", AnyIntOrReal}, DefaultingKIND}, KINDReal},
10361048
{"__builtin_ieee_support_datatype",
1037-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1049+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1050+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1051+
DefaultLogical},
10381052
{"__builtin_ieee_support_denormal",
1039-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1053+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1054+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1055+
DefaultLogical},
10401056
{"__builtin_ieee_support_divide",
1041-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1057+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1058+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1059+
DefaultLogical},
10421060
{"__builtin_ieee_support_flag",
10431061
{{"flag", IeeeFlagType, Rank::scalar},
1044-
{"x", AnyReal, Rank::known, Optionality::optional}},
1062+
{"x", AnyReal, Rank::known, Optionality::optional,
1063+
common::Intent::In,
1064+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
10451065
DefaultLogical},
10461066
{"__builtin_ieee_support_halting", {{"flag", IeeeFlagType, Rank::scalar}},
10471067
DefaultLogical},
10481068
{"__builtin_ieee_support_inf",
1049-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1069+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1070+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1071+
DefaultLogical},
10501072
{"__builtin_ieee_support_io",
1051-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1073+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1074+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1075+
DefaultLogical},
10521076
{"__builtin_ieee_support_nan",
1053-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1077+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1078+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1079+
DefaultLogical},
10541080
{"__builtin_ieee_support_rounding",
10551081
{{"round_value", IeeeRoundType, Rank::scalar},
1056-
{"x", AnyReal, Rank::known, Optionality::optional}},
1082+
{"x", AnyReal, Rank::known, Optionality::optional,
1083+
common::Intent::In,
1084+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
10571085
DefaultLogical},
10581086
{"__builtin_ieee_support_sqrt",
1059-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1087+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1088+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1089+
DefaultLogical},
10601090
{"__builtin_ieee_support_standard",
1061-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1091+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1092+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1093+
DefaultLogical},
10621094
{"__builtin_ieee_support_subnormal",
1063-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1095+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1096+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1097+
DefaultLogical},
10641098
{"__builtin_ieee_support_underflow_control",
1065-
{{"x", AnyReal, Rank::known, Optionality::optional}}, DefaultLogical},
1099+
{{"x", AnyReal, Rank::known, Optionality::optional, common::Intent::In,
1100+
{ArgFlag::canBeMoldNull, ArgFlag::onlyConstantInquiry}}},
1101+
DefaultLogical},
10661102
{"__builtin_numeric_storage_size", {}, DefaultInt},
10671103
};
10681104

@@ -2637,6 +2673,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
26372673
std::get_if<characteristics::DummyDataObject>(
26382674
&dc->u)}) {
26392675
dummyObject->type.set_corank(0);
2676+
if (d.flags.test(ArgFlag::onlyConstantInquiry)) {
2677+
dummyObject->attrs.set(
2678+
characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry);
2679+
}
26402680
}
26412681
dummyArgs.emplace_back(std::move(*dc));
26422682
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)