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 @@ -22,9 +22,9 @@ Constant(std::move(exts), ConstantSubscripts(c.shape()))); } -// for ALL & ANY +// for ALL, ANY & PARITY template -static Expr FoldAllAny(FoldingContext &context, FunctionRef &&ref, +static Expr FoldAllAnyParity(FoldingContext &context, FunctionRef &&ref, Scalar (Scalar::*operation)(const Scalar &) const, Scalar identity) { static_assert(T::category == TypeCategory::Logical); @@ -52,10 +52,10 @@ std::string name{intrinsic->name}; using SameInt = Type; if (name == "all") { - return FoldAllAny( + return FoldAllAnyParity( context, std::move(funcRef), &Scalar::AND, Scalar{true}); } else if (name == "any") { - return FoldAllAny( + return FoldAllAnyParity( context, std::move(funcRef), &Scalar::OR, Scalar{false}); } else if (name == "associated") { bool gotConstant{true}; @@ -203,6 +203,9 @@ } } else if (name == "merge") { return FoldMerge(context, std::move(funcRef)); + } else if (name == "parity") { + return FoldAllAnyParity( + context, std::move(funcRef), &Scalar::NEQV, Scalar{false}); } else if (name == "same_type_as") { // Type equality testing with SAME_TYPE_AS() ignores any type parameters. // Returns a constant truth value when the result is known now. diff --git a/flang/test/Evaluate/fold-parity.f90 b/flang/test/Evaluate/fold-parity.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/fold-parity.f90 @@ -0,0 +1,38 @@ +! RUN: %python %S/test_folding.py %s %flang_fc1 + +! Test fold parity intrinsic. + +module paritytest + logical, parameter :: test_1t = parity((/ .true. /)) + logical, parameter :: test_1f = .not. parity((/ .false. /)) + + logical, parameter :: test_e1 = .not. parity((/ .true., .true. /)) + logical, parameter :: test_o1 = parity((/ .true., .true., .true. /)) + logical, parameter :: test_o12 = parity((/ .true., .true., .true., .false. /)) + + logical, parameter, dimension(2, 3) :: a32 = reshape((/& + .true., .true., .false., & + .true., .true., .true. & + /), shape(a32), order=(/2, 1/)) + + logical, parameter, dimension(2, 3) :: a32t = reshape((/& + .true., .true., .true., & + .true., .true., .true. & + /), shape(a32t)) + + logical, parameter, dimension(2, 3) :: a32f = reshape((/& + .false., .false., .false., & + .false., .false., .false. & + /), shape(a32f)) + + logical, parameter :: test_a32 = parity(a32) + logical, parameter :: test_a32t = .not. parity(a32t) + logical, parameter :: test_a32f = .not. parity(a32f) + + logical, parameter :: test_a321 = & + all(parity(a32, 1) .EQV. (/ .false., .false., .true. /)) + + logical, parameter :: test_a322 = & + all(parity(a32, 2) .EQV. (/ .false., .true. /)) + +end module paritytest