1! { dg-do run }
2! { dg-options "-O" }
3! PR 80304 - this used to give a wrong result.
4! Original test case by Chinoune
5module test_mod
6  implicit none
7
8contains
9
10  pure real function add(i,j,k)
11    integer ,intent(in) :: i,j,k
12    add = real(i+j+k)+1.
13  end function add
14
15  pure real function add2(i,j,k)
16    integer ,intent(in) :: i,j,k
17    add2 = real(i+j+k)
18  end function add2
19
20  subroutine check_err(a, s)
21    real, dimension(:,:), intent(in) :: a
22    real, intent(in) :: s
23    if (abs(sum(a) - s) > 1e-5) STOP 1
24  end subroutine check_err
25
26end module test_mod
27
28program test
29  use test_mod
30  implicit none
31
32  integer :: i ,j
33  real :: a(0:1,0:1) ,b(0:1,0:1)
34
35  ! first do-concurrent loop
36  a = 0.
37  b = 0.
38  DO CONCURRENT( i=0:1 ,j=0:1)
39     a(i,j) = add(i,j,abs(i-j))
40     b(i,j) = add2(i,j,abs(i-j))
41  END DO
42  call check_err (a, 10.)
43  call check_err (b, 6.)
44
45  ! normal do loop
46  a = 0.
47  b = 0.
48  DO i=0,1
49     DO j=0,1
50        a(i,j) = add(i,j,abs(i-j))
51        b(i,j) = add2(i,j,abs(i-j))
52     END DO
53  END DO
54  call check_err (a, 10.)
55  call check_err (b, 6.)
56
57  ! second do-concuurent loop
58  a = 0.
59  b = 0.
60  DO CONCURRENT( i=0:1 ,j=0:1)
61     a(i,j) = add(i,j,abs(i-j))
62     b(i,j) = add2(i,j,abs(i-j))
63  END DO
64  call check_err (a, 10.)
65  call check_err (b, 6.)
66
67end program test
68