1! RUN: %S/test_errors.sh %s %t %f18
2! C1121 -- any procedure referenced in a concurrent header must be pure
3
4! Also, check that the step expressions are not zero.  This is prohibited by
5! Section 11.1.7.4.1, paragraph 1.
6
7SUBROUTINE do_concurrent_c1121(i,n)
8  IMPLICIT NONE
9  INTEGER :: i, n, flag
10  !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'random'
11  DO CONCURRENT (i = 1:n, random() < 3)
12    flag = 3
13  END DO
14
15  CONTAINS
16    IMPURE FUNCTION random() RESULT(i)
17      INTEGER :: i
18      i = 35
19    END FUNCTION random
20END SUBROUTINE do_concurrent_c1121
21
22SUBROUTINE s1()
23  INTEGER, PARAMETER :: constInt = 0
24
25  ! Warn on this one for backwards compatibility
26  DO 10 I = 1, 10, 0
27  10 CONTINUE
28
29  ! Warn on this one for backwards compatibility
30  DO 20 I = 1, 10, 5 - 5
31  20 CONTINUE
32
33  ! Error, no compatibility requirement for DO CONCURRENT
34  !ERROR: DO CONCURRENT step expression may not be zero
35  DO CONCURRENT (I = 1 : 10 : 0)
36  END DO
37
38  ! Error, this time with an integer constant
39  !ERROR: DO CONCURRENT step expression may not be zero
40  DO CONCURRENT (I = 1 : 10 : constInt)
41  END DO
42end subroutine s1
43