gcc/testsuite/gfortran.dg/where_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR35759 and PR35756 in which the dependencies
   3 ! led to an incorrect use of the "simple where", gfc_trans_where_3.
   4 !
   5 ! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
   6 !
   7   logical :: la(6) = (/(2*(i/2) /= i, i = 1, 6)/), lb(6)
   8   CALL PR35759
   9   CALL PR35756
  10 !
  11 ! The first version of the fix caused this to regress as pointed
  12 ! out by Dominique d'Humieres
  13 !
  14   lb = la
  15   where(la)
  16     la = .false.
  17   elsewhere
  18     la = .true.
  19   end where
  20   if (any(la .eqv. lb)) call abort()
  21 CONTAINS
  22   subroutine PR35759
  23     integer UDA1L(6)
  24     integer ::  UDA1R(6), expected(6) = (/2,0,5,0,3,0/)
  25     LOGICAL LDA(5)
  26     UDA1L(1:6) = 0
  27     uda1r = (/1,2,3,4,5,6/)
  28     lda = (/ (i/2*2 .ne. I, i=1,5) /)
  29     WHERE (LDA)
  30       UDA1L(1:5) = UDA1R(2:6)
  31     ELSEWHERE
  32       UDA1L(2:6) = UDA1R(6:2:-1)
  33     ENDWHERE
  34     if (any (expected /= uda1l)) call abort
  35   END subroutine
  36
  37   SUBROUTINE PR35756
  38     INTEGER  ILA(10), CLA(10)
  39     LOGICAL  LDA(10)
  40     ILA = (/ (I, i=1,10) /)
  41     LDA = (/ (i/2*2 .ne. I, i=1,10) /)
  42     WHERE(LDA)
  43       CLA = 10
  44     ELSEWHERE
  45       CLA = 2
  46     ENDWHERE
  47     WHERE(LDA)
  48       ILA = R_MY_MAX_I(ILA)
  49     ELSEWHERE
  50       ILA = R_MY_MIN_I(ILA)
  51     ENDWHERE
  52     IF (any (CLA /= ILA)) call abort
  53   end subroutine
  54
  55   INTEGER FUNCTION R_MY_MAX_I(A)
  56     INTEGER  ::  A(:)
  57     R_MY_MAX_I = MAXVAL(A)
  58   END FUNCTION R_MY_MAX_I
  59
  60   INTEGER FUNCTION R_MY_MIN_I(A)
  61     INTEGER  ::  A(:)
  62     R_MY_MIN_I = MINVAL(A)
  63   END FUNCTION R_MY_MIN_I
  64 END