From 64d3ef31dffb75b1a16837564eac5b613d49cafc Mon Sep 17 00:00:00 2001
From: Dominique d'Humieres <dominiq@lps.ens.fr>
Date: Thu, 7 Jan 2016 14:21:54 +0100
Subject: re PR fortran/66680 (ICE with openmp, a loop and a type bound
 procedure)

2016-01-07  Dominique d'Humieres <dominiq@lps.ens.fr>

	PR fortran/66680
	gfortran.dg/gomp/pr66680.f90: New test.

From-SVN: r232127
---
 gcc/testsuite/ChangeLog                    |  5 ++++
 gcc/testsuite/gfortran.dg/gomp/pr66680.f90 | 46 ++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr66680.f90

(limited to 'gcc')

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 53c1994..869d0fb 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-01-07  Dominique d'Humieres <dominiq@lps.ens.fr>
+
+	PR fortran/66680
+	gfortran.dg/gomp/pr66680.f90: New test.
+
 2016-01-07  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR target/69171
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr66680.f90 b/gcc/testsuite/gfortran.dg/gomp/pr66680.f90
new file mode 100644
index 0000000..b068cb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr66680.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! PR 66680: ICE with openmp, a loop and a type bound procedure
+! Contributed by Miha Polajnar <polajnar.miha@gmail.com>
+!
+module m1 
+  implicit none
+  integer :: n = 5
+  type :: t1
+  contains
+    procedure :: s => s1
+  end type t1
+contains
+  pure subroutine s1(self,p,esta)
+    class(t1), intent(in) :: self
+    integer, optional, intent(in) :: p
+    integer, intent(out) :: esta
+  end subroutine s1 
+end module m1
+module m2
+  use m1, only: t1, n
+  implicit none
+  type(t1), allocatable :: test(:)
+contains
+  pure subroutine s2(test1,esta)
+    type(t1), intent(in) :: test1
+    integer, intent(out) :: esta
+    integer :: p, i
+    do p = 1, n
+      i = p ! using i instead of p works
+      call test1%s(p=p,esta=esta)
+      if ( esta /= 0 ) return
+    end do
+  end subroutine s2
+  subroutine s3()
+    integer :: i, esta
+    !$omp parallel do  &
+    !$omp private(i)
+    do i = 1, n
+        call s2(test(i),esta)
+    end do
+    !$omp end parallel do
+  end subroutine s3
+end module m2
+program main
+  implicit none
+end program main
-- 
cgit v1.1