re PR tree-optimization/80304 (Wrong result with do concurrent)
authorThomas Koenig <tkoenig@gcc.gnu.org>
Mon, 10 Apr 2017 20:40:48 +0000 (20:40 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Mon, 10 Apr 2017 20:40:48 +0000 (20:40 +0000)
2017-04-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR tree-optimization/80304
* gfortran.dg/do_concurrent_4.f90:  New test case.

From-SVN: r246824

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/do_concurrent_4.f90 [new file with mode: 0644]

index 51fd41e..b0228bd 100644 (file)
@@ -1,3 +1,8 @@
+2017-04-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR tree-optimization/80304
+       * gfortran.dg/do_concurrent_4.f90:  New test case.
+
 2017-04-10  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/80046
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_4.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_4.f90
new file mode 100644 (file)
index 0000000..9c2409e
--- /dev/null
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-options "-O" }
+! PR 80304 - this used to give a wrong result.
+! Original test case by Chinoune
+module test_mod
+  implicit none
+
+contains
+
+  pure real function add(i,j,k)
+    integer ,intent(in) :: i,j,k
+    add = real(i+j+k)+1.
+  end function add
+
+  pure real function add2(i,j,k)
+    integer ,intent(in) :: i,j,k
+    add2 = real(i+j+k)
+  end function add2
+
+  subroutine check_err(a, s)
+    real, dimension(:,:), intent(in) :: a
+    real, intent(in) :: s
+    if (abs(sum(a) - s) > 1e-5) call abort
+  end subroutine check_err
+
+end module test_mod
+
+program test 
+  use test_mod
+  implicit none
+
+  integer :: i ,j
+  real :: a(0:1,0:1) ,b(0:1,0:1)
+
+  ! first do-concurrent loop  
+  a = 0.
+  b = 0.
+  DO CONCURRENT( i=0:1 ,j=0:1)
+     a(i,j) = add(i,j,abs(i-j))
+     b(i,j) = add2(i,j,abs(i-j))
+  END DO
+  call check_err (a, 10.)
+  call check_err (b, 6.)
+
+  ! normal do loop  
+  a = 0.
+  b = 0.
+  DO i=0,1 
+     DO j=0,1
+        a(i,j) = add(i,j,abs(i-j))
+        b(i,j) = add2(i,j,abs(i-j))
+     END DO
+  END DO
+  call check_err (a, 10.)
+  call check_err (b, 6.)
+
+  ! second do-concuurent loop  
+  a = 0.
+  b = 0.
+  DO CONCURRENT( i=0:1 ,j=0:1)
+     a(i,j) = add(i,j,abs(i-j))
+     b(i,j) = add2(i,j,abs(i-j))
+  END DO
+  call check_err (a, 10.)
+  call check_err (b, 6.)
+
+end program test