gcc/testsuite/gfortran.dg/do_concurrent_4.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O" }
   3 ! PR 80304 - this used to give a wrong result.
   4 ! Original test case by Chinoune
   5 module test_mod
   6   implicit none
   7
   8 contains
   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
  26 end module test_mod
  27
  28 program 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
  67 end program test