[flang] Warn on overflow folding DIM()

[klausler]

Summary

The intrinsic function DIM can overflow when its second argument
is negative. Detect this case for real and integer arguments and
emit a warning when necessary.

flang/include/flang/Evaluate/integer.h

public:
   constexpr ValueWithOverflow SubtractSigned(const Integer &y) const {
     bool isNegative{IsNegative()};
     bool sameSign{isNegative == y.IsNegative()};
     ValueWithCarry diff{AddUnsigned(y.Negate().value)};
     bool overflow{!sameSign && diff.value.IsNegative() != isNegative};
     return {diff.value, overflow};
   }
 
-  // MAX(X-Y, 0)
-  constexpr Integer DIM(const Integer &y) const {
+  // DIM(X,Y)=MAX(X-Y, 0)
+  constexpr ValueWithOverflow DIM(const Integer &y) const {
     if (CompareSigned(y) != Ordering::Greater) {
       return {};
     } else {
-      return SubtractSigned(y).value;
+      return SubtractSigned(y);
     }
   }
 
   constexpr ValueWithOverflow SIGN(bool toNegative) const {
     if (toNegative == IsNegative()) {
       return {*this, false};
     } else if (toNegative) {
       return Negate();

flang/lib/Evaluate/fold-integer.cpp

if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
       return Expr<T>{common::visit(
           [](const auto &kx) {
             return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS;
           },
           cx->u)};
     }
   } else if (name == "dim") {
-    return FoldElementalIntrinsic<T, T, T>(
-        context, std::move(funcRef), &Scalar<T>::DIM);
+    return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+        ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
+                                const Scalar<T> &y) -> Scalar<T> {
+          auto result{x.DIM(y)};
+          if (result.overflow) {
+            context.messages().Say("DIM intrinsic folding overflow"_warn_en_US);
+          }
+          return result.value;
+        }));
   } else if (name == "dot_product") {
     return FoldDotProduct<T>(context, std::move(funcRef));
   } else if (name == "dshiftl" || name == "dshiftr") {
     const auto fptr{
         name == "dshiftl" ? &Scalar<T>::DSHIFTL : &Scalar<T>::DSHIFTR};
     // Third argument can be of any kind. However, it must be smaller or equal
     // than BIT_SIZE. It can be converted to Int4 to simplify.
     if (const auto *shiftCon{Folder<Int4>(context).Folding(args[2])}) {

flang/lib/Evaluate/fold-real.cpp

return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
               if (y.flags.test(RealFlag::Overflow)) {
                 context.messages().Say(
                     "%s intrinsic folding overflow"_warn_en_US, name);
               }
               return y.value;
             }));
   } else if (name == "dim") {
     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
-        ScalarFunc<T, T, T>(
-            [](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
-              return x.DIM(y).value;
-            }));
+        ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
+                                const Scalar<T> &y) -> Scalar<T> {
+          ValueWithRealFlags<Scalar<T>> result{x.DIM(y)};
+          if (result.flags.test(RealFlag::Overflow)) {
+            context.messages().Say("DIM intrinsic folding overflow"_warn_en_US);
+          }
+          return result.value;
   } else if (name == "dot_product") {
     return FoldDotProduct<T>(context, std::move(funcRef));
   } else if (name == "dprod") {
     if (auto scalars{GetScalarConstantArguments<T, T>(context, args)}) {
       return Fold(context,
           Expr<T>{Multiply<T>{
               Expr<T>{std::get<0>(*scalars)}, Expr<T>{std::get<1>(*scalars)}}});
     }

flang/test/Evaluate/errors01.f90

contains
   end subroutine
   subroutine warnings
     real, parameter :: ok1 = scale(0.0, 99999) ! 0.0
     real, parameter :: ok2 = scale(1.0, -99999) ! 0.0
     !CHECK: SCALE intrinsic folding overflow
     real, parameter :: bad1 = scale(1.0, 99999)
     !CHECK: complex ABS intrinsic folding overflow
     real, parameter :: bad2 = abs(cmplx(huge(0.),huge(0.)))
+    !CHECK: warning: DIM intrinsic folding overflow
+    real, parameter :: bad3 = dim(huge(1.),-.5*huge(1.))
+    !CHECK: warning: DIM intrinsic folding overflow
+    integer, parameter :: bad4 = dim(huge(1),-1)
     !CHECK: warning: overflow on REAL(8) to REAL(4) conversion
     x = 1.D40
   end subroutine
 end module