[flang-commits] [flang] [flang] IEEE_SUPPORT_FLAG(..., LOCAL) in specification expression (PR #134270)

via flang-commits flang-commits at lists.llvm.org
Thu Apr 3 09:25:23 PDT 2025


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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.

---
Full diff: https://github.com/llvm/llvm-project/pull/134270.diff


4 Files Affected:

- (modified) flang/include/flang/Evaluate/characteristics.h (+1-1) 
- (modified) flang/lib/Evaluate/check-expression.cpp (+60-31) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+66-26) 
- (modified) flang/test/Evaluate/errors01.f90 (+8) 


``````````diff
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 0c15ec5473965..69858e41fda48 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},
@@ -562,7 +565,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},
@@ -650,7 +653,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,
@@ -724,7 +728,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,
@@ -769,7 +774,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,
@@ -798,7 +804,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,
@@ -838,21 +845,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)
@@ -979,7 +990,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",
@@ -1034,35 +1046,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},
 };
 
@@ -2637,6 +2673,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

``````````

</details>


https://github.com/llvm/llvm-project/pull/134270


More information about the flang-commits mailing list