1! { dg-do compile }
2! { dg-options "-fwhole-file" }
3! Tests the fix for PR22571 in which the derived types in a, b
4! c and d were not detected to be different.  In e and f, they
5! are the same because they are sequence types.
6!
7! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
8!
9subroutine a(p)
10  type t
11    integer :: t1
12  end type
13  type(t) :: p
14  p%t1 = 42
15end subroutine
16
17subroutine b
18  type u
19    integer :: u1
20  end type
21  type (u) :: q
22  call a(q)  ! { dg-warning "Type mismatch" }
23  print *, q%u1
24end subroutine
25
26subroutine c(p)
27  type u
28    integer :: u1
29  end type
30  type(u) :: p
31  p%u1 = 42
32end subroutine
33
34subroutine d
35  type u
36    integer :: u1
37  end type
38  type (u) :: q
39  call c(q)  ! { dg-warning "Type mismatch" }
40  print *, q%u1
41end subroutine
42
43subroutine e(p)
44  type u
45    sequence
46    integer :: u1
47  end type
48  type(u) :: p
49  p%u1 = 42
50end subroutine
51
52subroutine f
53  type u
54    sequence
55    integer :: u1
56  end type
57  type (u) :: q
58  call e(q)  ! This is OK because the types are sequence.
59  print *, q%u1
60end subroutine
61