diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -129,6 +129,7 @@ * 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 diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h --- a/flang/include/flang/Evaluate/real.h +++ b/flang/include/flang/Evaluate/real.h @@ -247,12 +247,17 @@ template static ValueWithRealFlags Convert( const A &x, Rounding rounding = defaultRounding) { + ValueWithRealFlags 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 result; int exponent{exponentBias + x.UnbiasedExponent()}; int bitsLost{A::binaryPrecision - binaryPrecision}; if (exponent < 1) { diff --git a/flang/lib/Evaluate/common.cpp b/flang/lib/Evaluate/common.cpp --- a/flang/lib/Evaluate/common.cpp +++ b/flang/lib/Evaluate/common.cpp @@ -19,7 +19,11 @@ 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); diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -89,6 +89,15 @@ [&fptr](const Scalar &i, const Scalar &j) { return Scalar{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; + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNotANumber()}; + })); } else if (name == "is_contiguous") { if (args.at(0)) { if (auto *expr{args[0]->UnwrapExpr()}) { diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -476,6 +476,7 @@ {{"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}, @@ -744,7 +745,7 @@ // 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 diff --git a/flang/test/Evaluate/folding03.f90 b/flang/test/Evaluate/folding03.f90 --- a/flang/test/Evaluate/folding03.f90 +++ b/flang/test/Evaluate/folding03.f90 @@ -79,9 +79,9 @@ !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) diff --git a/flang/test/Evaluate/folding04.f90 b/flang/test/Evaluate/folding04.f90 --- a/flang/test/Evaluate/folding04.f90 +++ b/flang/test/Evaluate/folding04.f90 @@ -12,9 +12,9 @@ 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 diff --git a/flang/test/Evaluate/folding14.f90 b/flang/test/Evaluate/folding14.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/folding14.f90 @@ -0,0 +1,18 @@ +! 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