OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [internal_pack_10.f90] - Blame information for rev 708

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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 
7
! further reduced by Tobias Burnus 
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
41
! { dg-final { cleanup-modules "mo_obs_rules" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.