[flang] Add isnan() extension intrinsic function, with folding

[klausler]

Summary

It's nonstandard, but commonly implemented.

[jeanPerier]

Looks good to me

flang/docs/Extensions.md

 * A `RETURN` statement may appear in a main program.
 * DATA statement initialization is allowed for procedure pointers outside
   structure constructors.
+* Nonstandard intrinsic functions: ISNAN
 
 ### Extensions supported when enabled by options
 

flang/include/flang/Evaluate/real.h

   template <typename A>
   static ValueWithRealFlags<Real> Convert(
       const A &x, Rounding rounding = defaultRounding) {
+    ValueWithRealFlags<Real> result;
+    if (x.IsNotANumber()) {
+      result.flags.set(RealFlag::InvalidArgument);
+      result.value = NotANumber();
+      return result;
+    }
     bool isNegative{x.IsNegative()};
     A absX{x};
     if (isNegative) {
       absX = x.Negate();
     }
-    ValueWithRealFlags<Real> result;
     int exponent{exponentBias + x.UnbiasedExponent()};
     int bitsLost{A::binaryPrecision - binaryPrecision};
     if (exponent < 1) {

flang/lib/Evaluate/common.cpp

     context.messages().Say("overflow on %s"_en_US, operation);
   }
   if (flags.test(RealFlag::DivideByZero)) {
-    context.messages().Say("division by zero on %s"_en_US, operation);
+    if (std::strcmp(operation, "division") == 0) {
+      context.messages().Say("division by zero"_en_US);
+    } else {
+      context.messages().Say("division on %s"_en_US);
+    }
   }
   if (flags.test(RealFlag::InvalidArgument)) {
     context.messages().Say("invalid argument on %s"_en_US, operation);

flang/lib/Evaluate/fold-logical.cpp

             [&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
               return Scalar<T>{std::invoke(fptr, i, j)};
             }));
+  } else if (name == "isnan") {
+    // A warning about an invalid argument is discarded from converting
+    // the argument of isnan().
+    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()};
+        }));
   } else if (name == "is_contiguous") {
     if (args.at(0)) {
       if (auto *expr{args[0]->UnwrapExpr()}) {

flang/lib/Evaluate/intrinsics.cpp

         {{"i", SameInt}, {"shift", AnyInt},
             {"size", AnyInt, Rank::elemental, Optionality::optional}},
         SameInt},
+    {"isnan", {{"a", AnyFloating}}, DefaultLogical},
     {"is_contiguous", {{"array", Addressable, Rank::anyOrAssumedRank}},
         DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
     {"is_iostat_end", {{"i", AnyInt}}, DefaultLogical},

 //  INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF,
 //  MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
 //  IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,
-//  EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC
+//  EOF, FP_CLASS, INT_PTR_KIND, MALLOC
 //  probably more (these are PGI + Intel, possibly incomplete)
 // TODO: Optionally warn on use of non-standard intrinsics:
 //  LOC, probably others

flang/test/Evaluate/folding03.f90

   !WARN: invalid argument on division
   real(4), parameter :: r4_nan = 0._4/0._4
   TEST_ISNAN(r4_nan)
-  !WARN: division by zero on division
+  !WARN: division by zero
   real(4), parameter :: r4_pinf = 1._4/0._4
-  !WARN: division by zero on division
+  !WARN: division by zero
   real(4), parameter :: r4_ninf = -1._4/0._4
 
   logical, parameter :: test_r4_nan_parentheses1 = .NOT.(((r4_nan)).EQ.r4_nan)

flang/test/Evaluate/folding04.f90

   real(4), parameter :: r4_nmax = -3.4028235E38
   !WARN: invalid argument on division
   real(4), parameter :: r4_nan = 0._4/0._4
-  !WARN: division by zero on division
+  !WARN: division by zero
   real(4), parameter :: r4_pinf = 1._4/0._4
-  !WARN: division by zero on division
+  !WARN: division by zero
   real(4), parameter :: r4_ninf = -1._4/0._4
 
   !WARN: invalid argument on intrinsic function

flang/test/Evaluate/folding14.f90

+! RUN: %S/test_folding.sh %s %t %f18
+! Test folding of isnan() extension
+module m1
+  logical, parameter :: results(*) = isnan([ &
+    0., &
+    -0., &
+!WARN: division by zero
+    1./0., &
+!WARN: invalid argument on division
+    0./0., &
+    real(z'7ff80001',kind=4), &
+    real(z'fff80001',kind=4), &
+    real(z'7ffc0000',kind=4), &
+    real(z'7ffe0000',kind=4) ])
+  logical, parameter :: expected(*) = [ &
+    .false., .false., .false., .true., .true., .true., .true., .true. ]
+  logical, parameter :: test_isnan = all(results .eqv. expected)
+end module