libgomp/testsuite/libgomp.fortran/pr66680.f90

   1 ! { dg-do run }
   2 ! PR 66680: ICE with openmp, a loop and a type bound procedure
   3 ! Contributed by Miha Polajnar <polajnar.miha@gmail.com>
   4 !
   5 module m1
   6   implicit none
   7   integer :: n = 5
   8   type :: t1
   9   contains
  10     procedure :: s => s1
  11   end type t1
  12 contains
  13   pure subroutine s1(self,p,esta)
  14     class(t1), intent(in) :: self
  15     integer, optional, intent(in) :: p
  16     integer, intent(out) :: esta
  17   end subroutine s1
  18 end module m1
  19 module m2
  20   use m1, only: t1, n
  21   implicit none
  22   type(t1), allocatable :: test(:)
  23 contains
  24   pure subroutine s2(test1,esta)
  25     type(t1), intent(in) :: test1
  26     integer, intent(out) :: esta
  27     integer :: p, i
  28     do p = 1, n
  29       i = p ! using i instead of p works
  30       call test1%s(p=p,esta=esta)
  31       if ( esta /= 0 ) return
  32     end do
  33   end subroutine s2
  34   subroutine s3()
  35     integer :: i, esta
  36     !$omp parallel do  &
  37     !$omp private(i)
  38     do i = 1, n
  39         call s2(test(i),esta)
  40     end do
  41     !$omp end parallel do
  42   end subroutine s3
  43 end module m2
  44 program main
  45   implicit none
  46 end program main