1! { dg-do compile }
2! { dg-additional-options "-fdump-tree-original" }
3!
4! PR fortran/66549
5! The resolution of CVN in the middle CLWF's OpenMP construct was
6! making the DO loop (wrongly) interpreted as an OpenMP-managed loop, leading
7! to an ICE.
8!
9! Contributed by Andrew Benson <abensonca@gmail.com>.
10
11module smfa
12  type :: sgc
13   contains
14     procedure :: sla => sa
15  end type sgc
16  class(sgc), pointer :: sg_
17  double precision, allocatable, dimension(:) :: vni
18contains
19  double precision function sa(self,i)
20    class(sgc), intent(in   ) :: self
21  end function sa
22  subroutine cvn(sg_,vn)
23    class(sgc), intent(inout) :: sg_
24    double precision, intent(  out), dimension(:) :: vn
25    integer :: i
26    do i=1,2
27       vn(i)= sg_%sla(i)
28    end do
29  end subroutine cvn
30  subroutine clwf()
31    !$omp parallel
32    call cvn(sg_,vni)
33    !$omp end parallel
34  end subroutine clwf
35end module smfa
36
37! { dg-final { scan-tree-dump-times "#pragma\\s+omp\\s+parallel\\n" 1 "original" } }
38