gcc/testsuite/gfortran.dg/internal_pack_10.f90

   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 !
   9 module 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)
  18 contains
  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
  34 end module mo_obs_rules
  35
  36 program test
  37   use mo_obs_rules
  38   type(t_set) :: c (1)
  39   call get_rule (c)
  40 end program test