1! { dg-do run }
2! Test the fix for PR43180, in which patch which reduced the use of
3! internal_pack/unpack messed up the passing of ru(1)%c as the actual
4! argument at line 23 in this testcase.
5!
6! Contributed by Harald Anlauf <anlauf@gmx.de>
7! further reduced by Tobias Burnus <burnus@gcc.gnu.org>
8!
9module mo_obs_rules
10  type t_set
11     integer :: use = 42
12  end type t_set
13  type t_rules
14     character(len=40) :: comment
15     type(t_set)       :: c (1)
16  end type t_rules
17  type (t_rules), save :: ru (1)
18contains
19  subroutine get_rule (c)
20    type(t_set) :: c (:)
21    ru(1)%c(:)%use = 99
22    if (any (c(:)%use .ne. 42)) call abort
23    call set_set_v (ru(1)%c, c)
24    if (any (c(:)%use .ne. 99)) call abort
25  contains
26    subroutine set_set_v (src, dst)
27      type(t_set), intent(in)    :: src(1)
28      type(t_set), intent(inout) :: dst(1)
29    if (any (src%use .ne. 99)) call abort
30    if (any (dst%use .ne. 42)) call abort
31      dst = src
32    end subroutine set_set_v
33  end subroutine get_rule
34end module mo_obs_rules
35
36program test
37  use mo_obs_rules
38  type(t_set) :: c (1)
39  call get_rule (c)
40end program test
41