[flang] Fold BTEST

[klausler]

Summary

Implements constant folding for BTEST intrinsic function.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/type.h

 using common::TypeCategory;
 
 // Specific intrinsic types are represented by specializations of
 // this class template Type<CATEGORY, KIND>.
 template <TypeCategory CATEGORY, int KIND = 0> class Type;
 
 using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 using CInteger = Type<TypeCategory::Integer, 4>;
+using LargestInt = Type<TypeCategory::Integer, 16>;
 using LogicalResult = Type<TypeCategory::Logical, 4>;
 using LargestReal = Type<TypeCategory::Real, 16>;
 using Ascii = Type<TypeCategory::Character, 1>;
 
 // A predicate that is true when a kind value is a kind that could possibly
 // be supported for an intrinsic type category on some target instruction
 // set architecture.
 // TODO: specialize for the actual target architecture

flang/lib/Evaluate/fold-logical.cpp

 Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     FoldingContext &context,
     FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Logical, KIND>;
   ActualArguments &args{funcRef.arguments()};
   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
   CHECK(intrinsic);
   std::string name{intrinsic->name};
+  using SameInt = Type<TypeCategory::Integer, KIND>;
   if (name == "all") {
     return FoldAllAny(
         context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
   } else if (name == "any") {
     return FoldAllAny(
         context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
   } else if (name == "associated") {
     bool gotConstant{true};
     const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()};
     if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) {
       gotConstant = false;
     } else if (args[1]) { // There's a second argument
       const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()};
       if (!secondArgExpr || !IsNullPointer(*secondArgExpr)) {
         gotConstant = false;
       }
     }
     return gotConstant ? Expr<T>{false} : Expr<T>{std::move(funcRef)};
   } else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
-    using LargestInt = Type<TypeCategory::Integer, 16>;
     static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
     // Arguments do not have to be of the same integer type. Convert all
     // arguments to the biggest integer type before comparing them to
     // simplify.
     for (int i{0}; i <= 1; ++i) {
       if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) {
         *args[i] = AsGenericExpr(
             Fold(context, ConvertToType<LargestInt>(std::move(*x))));
if (name == "bge") { // done in fptr declaration
       common::die("missing case to fold intrinsic function %s", name.c_str());
     }
     return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context,
         std::move(funcRef),
         ScalarFunc<T, LargestInt, LargestInt>(
             [&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
               return Scalar<T>{std::invoke(fptr, i, j)};
             }));
+  } else if (name == "btest") {
+    if (const auto *ix{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
+      return std::visit(
+          [&](const auto &x) {
+            using IT = ResultType<decltype(x)>;
+            return FoldElementalIntrinsic<T, IT, SameInt>(context,
+                std::move(funcRef),
+                ScalarFunc<T, IT, SameInt>(
+                    [&](const Scalar<IT> &x, const Scalar<SameInt> &pos) {
+                      auto posVal{pos.ToInt64()};
+                      if (posVal < 0 || posVal >= x.bits) {
+                        context.messages().Say(
+                            "POS=%jd out of range for BTEST"_err_en_US,
+                            static_cast<std::intmax_t>(posVal));
+                      }
+                      return Scalar<T>{x.BTEST(posVal)};
+                    }));
+          },
+          ix->u);
+    }
   } else if (name == "isnan" || name == "__builtin_ieee_is_nan") {
     // A warning about an invalid argument is discarded from converting
     // the argument of isnan() / IEEE_IS_NAN().
     auto restorer{context.messages().DiscardMessages()};
     using DefaultReal = Type<TypeCategory::Real, 4>;
     return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
         ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
           return Scalar<T>{x.IsNotANumber()};
return FoldMerge<T>(context, std::move(funcRef));
       name == "__builtin_ieee_support_io" ||
       name == "__builtin_ieee_support_nan" ||
       name == "__builtin_ieee_support_sqrt" ||
       name == "__builtin_ieee_support_standard" ||
       name == "__builtin_ieee_support_subnormal" ||
       name == "__builtin_ieee_support_underflow_control") {
     return Expr<T>{true};
   }
-  // TODO: btest, dot_product, is_iostat_end,
+  // TODO: dot_product, is_iostat_end,
   // is_iostat_eor, logical, matmul, out_of_range,
   // parity, transfer
   return Expr<T>{std::move(funcRef)};
 }
 
 template <typename T>
 Expr<LogicalResult> FoldOperation(
     FoldingContext &context, Relational<T> &&relation) {

flang/test/Evaluate/fold-btest.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of BTEST
+module m1
+  integer, parameter :: ia1(*) = [(j, j=0, 15)]
+  logical, parameter :: test_ia1a = all(btest(ia1, 0) .eqv. [(.false., .true., j=1, 8)])
+  logical, parameter :: test_ia1b = all(btest(ia1, 1) .eqv. [(.false., .false., .true., .true., j=1, 4)])
+  logical, parameter :: test_ia1c = all(btest(ia1, 2) .eqv. [(modulo(j/4, 2) == 1, j=0, 15)])
+  logical, parameter :: test_ia1d = all(btest(ia1, 3) .eqv. [(j > 8, j=1, 16)])
+  logical, parameter :: test_shft1 = all([(btest(ishft(1_1, j), j), j=0, 7)])
+  logical, parameter :: test_shft2 = all([(btest(ishft(1_2, j), j), j=0, 15)])
+  logical, parameter :: test_shft4 = all([(btest(ishft(1_4, j), j), j=0, 31)])
+  logical, parameter :: test_shft8 = all([(btest(ishft(1_8, j), j), j=0, 63)])
+  logical, parameter :: test_shft16 = all([(btest(ishft(1_16, j), j), j=0, 127)])
+  logical, parameter :: test_set1 = all([(btest(ibset(0_1, j), j), j=0, 7)])
+  logical, parameter :: test_set2 = all([(btest(ibset(0_2, j), j), j=0, 15)])
+  logical, parameter :: test_set4 = all([(btest(ibset(0_4, j), j), j=0, 31)])
+  logical, parameter :: test_set8 = all([(btest(ibset(0_8, j), j), j=0, 63)])
+  logical, parameter :: test_set16 = all([(btest(ibset(0_16, j), j), j=0, 127)])
+  logical, parameter :: test_z = .not. any([(btest(0_4, j), j=0, 31)])
+  logical, parameter :: test_shft1e = all(btest([(ishft(1_1, j), j=0, 7)], [(j, j=0, 7)]))
+end module

flang/test/Evaluate/folding19.f90

contains
   end subroutine
   subroutine s5
     logical, parameter :: mask(2,3) = reshape([.false., .true., .true., .false., .false., .true.], shape(mask))
     integer, parameter :: field(3,2) = reshape([(-j,j=1,6)], shape(field))
     integer :: x(2,3)
     !CHECK: error: Invalid 'vector=' argument in UNPACK: the 'mask=' argument has 3 true elements, but the vector has only 2 elements
     x = unpack([1,2], mask, 0)
   end subroutine
+  subroutine s6
+    !CHECK: error: POS=-1 out of range for BTEST
+    logical, parameter :: bad1 = btest(0, -1)
+    !CHECK: error: POS=32 out of range for BTEST
+    logical, parameter :: bad2 = btest(0, 32)
+    !CHECK-NOT: error: POS=33 out of range for BTEST
+    logical, parameter :: bad3 = btest(0_8, 33)
+    !CHECK: error: POS=64 out of range for BTEST
+    logical, parameter :: bad4 = btest(0_8, 64)
+  end subroutine
 end module