1! { dg-do run }
2! Tests the fix for PR34820, in which the nullification of the
3! automatic array iregion occurred in the caller, rather than the
4! callee.  Since 'nproc' was not available, an ICE ensued. During
5! the bug fix, it was found that the scalar to array assignment
6! of derived types with allocatable components did not work and
7! the fix of this is tested too.
8!
9! Contributed by Toon Moene <toon@moene.indiv.nluug.nl>
10!
11module grid_io
12  type grid_index_region
13    integer, allocatable::lons(:)
14  end type grid_index_region
15contains
16  subroutine read_grid_header()
17    integer :: npiece = 1
18    type(grid_index_region),allocatable :: iregion(:)
19    allocate (iregion(npiece + 1))
20    call read_iregion(npiece,iregion)
21    if (size(iregion) .ne. npiece + 1) STOP 1
22    if (.not.allocated (iregion(npiece)%lons)) STOP 2
23    if (allocated (iregion(npiece+1)%lons)) STOP 3
24    if (any (iregion(npiece)%lons .ne. [(i, i = 1, npiece)])) STOP 4
25    deallocate (iregion)
26  end subroutine read_grid_header
27
28  subroutine read_iregion (nproc,iregion)
29    integer,intent(in)::nproc
30    type(grid_index_region), intent(OUT)::iregion(1:nproc)
31    integer :: iarg(nproc)
32    iarg = [(i, i = 1, nproc)]
33    iregion = grid_index_region (iarg) !
34  end subroutine read_iregion
35end module grid_io
36
37  use grid_io
38  call read_grid_header
39end
40