[flang] Fold IBITS() intrinsic function

[klausler]

Summary

Implement constant folding of IBITS(); add test.

flang/lib/Evaluate/fold-integer.cpp

return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
                 "bit position for %s (%d) is negative"_err_en_US, name, posVal);
           } else if (posVal >= i.bits) {
             context.messages().Say(
                 "bit position for %s (%d) is not less than %d"_err_en_US, name,
                 posVal, i.bits);
           }
           return std::invoke(fptr, i, posVal);
         }));
+  } else if (name == "ibits") {
+    return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
+        ScalarFunc<T, T, Int4, Int4>([&](const Scalar<T> &i,
+                                         const Scalar<Int4> &pos,
+                                         const Scalar<Int4> &len) -> Scalar<T> {
+          auto posVal{static_cast<int>(pos.ToInt64())};
+          auto lenVal{static_cast<int>(len.ToInt64())};
+          if (posVal < 0) {
+            context.messages().Say(
+                "bit position for IBITS(POS=%d,LEN=%d) is negative"_err_en_US,
+                posVal, lenVal);
+          } else if (lenVal < 0) {
+            context.messages().Say(
+                "bit length for IBITS(POS=%d,LEN=%d) is negative"_err_en_US,
+                posVal, lenVal);
+          } else if (posVal + lenVal > i.bits) {
+            context.messages().Say(
+                "IBITS(POS=%d,LEN=%d) must have POS+LEN no greater than %d"_err_en_US,
+                posVal + lenVal, i.bits);
+          }
+          return i.IBITS(posVal, lenVal);
+        }));
   } else if (name == "index" || name == "scan" || name == "verify") {
     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
       return std::visit(
           [&](const auto &kch) -> Expr<T> {
             using TC = typename std::decay_t<decltype(kch)>::Result;
             if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
               return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
                   std::move(funcRef),
if (auto info{
             Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
       }
     }
   } else if (name == "sum") {
     return FoldSum<T>(context, std::move(funcRef));
   } else if (name == "ubound") {
     return UBOUND(context, std::move(funcRef));
   }
-  // TODO: dot_product, ibits, ishftc, matmul, sign, transfer
+  // TODO: dot_product, ishftc, matmul, sign, transfer
   return Expr<T>{std::move(funcRef)};
 }
 
 // Substitutes a bare type parameter reference with its value if it has one now
 // in an instantiation.  Bare LEN type parameters are substituted only when
 // the known value is constant.
 Expr<TypeParamInquiry::Result> FoldOperation(
     FoldingContext &context, TypeParamInquiry &&inquiry) {

flang/test/Evaluate/fold-ibits.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of IBITS exhaustively over POS/LEN ranges
+module m1
+  implicit integer(a-z)
+  integer, parameter :: res1(*) = [((ibits(not(0),pos,len),len=0,31-pos),pos=0,31)]
+  integer, parameter :: expect1(*) = [((maskr(len),len=0,31-pos),pos=0,31)]
+  logical, parameter :: test1 = all(res1 == expect1)
+  logical, parameter :: test2 = all([((ibits(0,pos,len),len=0,31-pos),pos=0,31)] == 0)
+  integer, parameter :: mess = z'a5a55a5a'
+  integer, parameter :: res3(*) = [((ibits(mess,pos,len),len=0,31-pos),pos=0,31)]
+  integer, parameter :: expect3(*) = [((iand(shiftr(mess,pos),maskr(len)),len=0,31-pos),pos=0,31)]
+  logical, parameter :: test3 = all(res3 == expect3)
+end module