gcc/testsuite/gfortran.dg/parity_1.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/33197
   4 !
   5 ! Check implementation of PARITY
   6 !
   7 implicit none
   8
   9 integer :: i
  10 logical :: Lt(1) = [ .true. ]
  11 logical :: Lf(1) = [ .false.]
  12 logical :: Ltf(2) = [ .true., .false. ]
  13 logical :: Ltftf(4) = [.true., .false., .true.,.false.]
  14
  15 if (parity([logical ::]) .neqv. .false.) call abort()
  16 if (parity([.true., .false.]) .neqv. .true.) call abort()
  17 if (parity([.true.]) .neqv. .true.) call abort()
  18 if (parity([.false.]) .neqv. .false.) call abort()
  19 if (parity([.true., .false., .true.,.false.]) .neqv. .false.) call abort()
  20 if (parity(reshape([.true., .false., .true.,.false.],[2,2])) &
  21     .neqv. .false.) call abort()
  22 if (any (parity(reshape([.true., .false., .true.,.false.],[2,2]),dim=1) &
  23          .neqv. [.true., .true.])) call abort()
  24 if (any (parity(reshape([.true., .false., .true.,.false.],[2,2]),dim=2) &
  25          .neqv. [.false., .false.])) call abort()
  26
  27 i = 0
  28 if (parity(Lt(1:i)) .neqv. .false.) call abort()
  29 if (parity(Ltf) .neqv. .true.) call abort()
  30 if (parity(Lt) .neqv. .true.) call abort()
  31 if (parity(Lf) .neqv. .false.) call abort()
  32 if (parity(Ltftf) .neqv. .false.) call abort()
  33 if (parity(reshape(Ltftf,[2,2])) &
  34     .neqv. .false.) call abort()
  35 if (any (parity(reshape(Ltftf,[2,2]),dim=1) &
  36          .neqv. [.true., .true.])) call abort()
  37 if (any (parity(reshape(Ltftf,[2,2]),dim=2) &
  38          .neqv. [.false., .false.])) call abort()
  39
  40 end