[flang] Fix bogus folding error for ISHFT(x, negative)

[klausler]

Summary

Negative shift counts are of course valid for ISHFT when
shifting to the right. This patch decouples the folding of
ISHFT from that of SHIFTA/L/R and adds tests.

flang/lib/Evaluate/fold-integer.cpp

if (name == "abs") {
     if constexpr (common::HasMember<T, IntegerTypes>) {
       return Expr<T>{args[0].value().GetType()->kind()};
     } else {
       DIE("kind() result not integral");
     }
   } else if (name == "iparity") {
     return FoldBitReduction(
         context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
-  } else if (name == "ishft" || name == "shifta" || name == "shiftr" ||
-      name == "shiftl") {
-    // Second argument can be of any kind. However, it must be smaller or
-    // equal than BIT_SIZE. It can be converted to Int4 to simplify.
-    auto fptr{&Scalar<T>::ISHFT};
-    if (name == "ishft") { // done in fptr definition
-    } else if (name == "shifta") {
-      fptr = &Scalar<T>::SHIFTA;
-    } else if (name == "shiftr") {
-      fptr = &Scalar<T>::SHIFTR;
-    } else if (name == "shiftl") {
-      fptr = &Scalar<T>::SHIFTL;
-    } else {
-      common::die("missing case to fold intrinsic function %s", name.c_str());
-    }
+  } else if (name == "ishft") {
     return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
         ScalarFunc<T, T, Int4>([&](const Scalar<T> &i,
                                    const Scalar<Int4> &pos) -> Scalar<T> {
           auto posVal{static_cast<int>(pos.ToInt64())};
-          if (posVal < 0) {
+          if (posVal < -i.bits) {
             context.messages().Say(
-                "shift count for %s (%d) is negative"_err_en_US, name, posVal);
+                "SHIFT=%d count for ishft is less than %d"_err_en_US, posVal,
+                -i.bits);
           } else if (posVal > i.bits) {
             context.messages().Say(
-                "shift count for %s (%d) is greater than %d"_err_en_US, name,
-                posVal, i.bits);
+                "SHIFT=%d count for ishft is greater than %d"_err_en_US, posVal,
+                i.bits);
           }
-          return std::invoke(fptr, i, posVal);
+          return i.ISHFT(posVal);
         }));
   } else if (name == "lbound") {
     return LBOUND(context, std::move(funcRef));
   } else if (name == "leadz" || name == "trailz" || name == "poppar" ||
       name == "popcnt") {
     if (auto *sn{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
       return std::visit(
           [&funcRef, &context, &name](const auto &n) -> Expr<T> {
if (auto p{GetInt64ArgOr(args[0], 0)}) {
       }
     }
   } else if (name == "shape") {
     if (auto shape{GetShape(context, args[0])}) {
       if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
         return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
       }
     }
+  } else if (name == "shifta" || name == "shiftr" || name == "shiftl") {
+    // Second argument can be of any kind. However, it must be smaller or
+    // equal than BIT_SIZE. It can be converted to Int4 to simplify.
+    auto fptr{&Scalar<T>::SHIFTA};
+    if (name == "shifta") { // done in fptr definition
+    } else if (name == "shiftr") {
+      fptr = &Scalar<T>::SHIFTR;
+    } else if (name == "shiftl") {
+      fptr = &Scalar<T>::SHIFTL;
+    } else {
+      common::die("missing case to fold intrinsic function %s", name.c_str());
+    }
+    return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+        ScalarFunc<T, T, Int4>([&](const Scalar<T> &i,
+                                   const Scalar<Int4> &pos) -> Scalar<T> {
+          auto posVal{static_cast<int>(pos.ToInt64())};
+          if (posVal < 0) {
+            context.messages().Say(
+                "SHIFT=%d count for %s is negative"_err_en_US, posVal, name);
+          } else if (posVal > i.bits) {
+            context.messages().Say(
+                "SHIFT=%d count for %s is greater than %d"_err_en_US, posVal,
+                name, i.bits);
+          }
+          return std::invoke(fptr, i, posVal);
+        }));
   } else if (name == "sign") {
     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
         ScalarFunc<T, T, T>(
             [&context](const Scalar<T> &j, const Scalar<T> &k) -> Scalar<T> {
               typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
               if (result.overflow) {
                 context.messages().Say(
                     "sign(integer(kind=%d)) folding overflowed"_en_US, KIND);

flang/test/Evaluate/fold-ishft.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of ISHFT
+module m1
+  logical :: test_ishft_lsb = all(ishft(1, [-32, -31, -1, 0, 1, 2, 31, 32]) == [0, 0, 0, 1, 2, 4, int(z'80000000'), 0])
+  logical :: test_ishft_msb = all(ishft(ishft(1,31), [-32, -31, -1, 0, 1, 2, 31, 32]) == [0, 1, int(z'40000000'), int(z'80000000'), 0, 0, 0, 0])
+end module

flang/test/Evaluate/folding19.f90

subroutine s5
     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)
+    logical, parameter :: ok1 = btest(0_8, 33)
     !CHECK: error: POS=64 out of range for BTEST
     logical, parameter :: bad4 = btest(0_8, 64)
   end subroutine
+  subroutine s7
+    !CHECK: error: SHIFT=-33 count for ishft is less than -32
+    integer, parameter :: bad1 = ishft(1, -33)
+    integer, parameter :: ok1 = ishft(1, -32)
+    integer, parameter :: ok2 = ishft(1, 32)
+    !CHECK: error: SHIFT=33 count for ishft is greater than 32
+    integer, parameter :: bad2 = ishft(1, 33)
+    !CHECK: error: SHIFT=-65 count for ishft is less than -64
+    integer(8), parameter :: bad3 = ishft(1_8, -65)
+    integer(8), parameter :: ok3 = ishft(1_8, -64)
+    integer(8), parameter :: ok4 = ishft(1_8, 64)
+    !CHECK: error: SHIFT=65 count for ishft is greater than 64
+    integer(8), parameter :: bad4 = ishft(1_8, 65)
+  end subroutine
+  subroutine s8
+    !CHECK: error: SHIFT=-33 count for shiftl is negative
+    integer, parameter :: bad1 = shiftl(1, -33)
+    !CHECK: error: SHIFT=-32 count for shiftl is negative
+    integer, parameter :: bad2 = shiftl(1, -32)
+    integer, parameter :: ok1 = shiftl(1, 32)
+    !CHECK: error: SHIFT=33 count for shiftl is greater than 32
+    integer, parameter :: bad3 = shiftl(1, 33)
+    !CHECK: error: SHIFT=-65 count for shiftl is negative
+    integer(8), parameter :: bad4 = shiftl(1_8, -65)
+    !CHECK: error: SHIFT=-64 count for shiftl is negative
+    integer(8), parameter :: bad5 = shiftl(1_8, -64)
+    integer(8), parameter :: ok2 = shiftl(1_8, 64)
+    !CHECK: error: SHIFT=65 count for shiftl is greater than 64
+    integer(8), parameter :: bad6 = shiftl(1_8, 65)
+  end subroutine
 end module