OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [where_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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 
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.