Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/impure_1.f08 @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
1 ! { dg-do run } 1 ! { dg-do run }
2 ! { dg-options "-std=f2008 -fall-intrinsics" } 2 ! { dg-options "-std=f2008 " }
3 3
4 ! PR fortran/45197 4 ! PR fortran/45197
5 ! Check that IMPURE and IMPURE ELEMENTAL in particular works. 5 ! Check that IMPURE and IMPURE ELEMENTAL in particular works.
6 6
7 ! Contributed by Daniel Kraft, d@domob.eu. 7 ! Contributed by Daniel Kraft, d@domob.eu.
40 a = (/ (i, i = 1, n) /) 40 a = (/ (i, i = 1, n) /)
41 41
42 ! Traverse in forward order. 42 ! Traverse in forward order.
43 s = 0 43 s = 0
44 b = accumulate (a, s) 44 b = accumulate (a, s)
45 IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) CALL abort () 45 IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) STOP 1
46 46
47 ! And now backward. 47 ! And now backward.
48 s = 0 48 s = 0
49 b = accumulate (a(n:1:-1), s) 49 b = accumulate (a(n:1:-1), s)
50 IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) CALL abort () 50 IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) STOP 2
51 51
52 ! Use subroutine. 52 ! Use subroutine.
53 i = 1 53 i = 1
54 arr = 0 54 arr = 0
55 CALL impureSub (a) 55 CALL impureSub (a)
56 IF (ANY (arr /= a)) CALL abort () 56 IF (ANY (arr /= a)) STOP 3
57 57
58 CONTAINS 58 CONTAINS
59 59
60 IMPURE ELEMENTAL FUNCTION accumulate (a, s) 60 IMPURE ELEMENTAL FUNCTION accumulate (a, s)
61 INTEGER, INTENT(IN) :: a 61 INTEGER, INTENT(IN) :: a