1! { dg-do compile }
2! This checks the fix for PR20864 in which same name, USE associated
3! derived types from different modules, with private components were
4! not recognised to be different.
5!
6! Contributed by Joost VandVondele  <jv244@cam.ac.uk>
7!==============
8  MODULE T1
9    TYPE data_type
10      SEQUENCE
11  ! private causes the types in T1 and T2 to be different 4.4.2
12      PRIVATE
13      INTEGER :: I
14    END TYPE
15  END MODULE
16
17  MODULE T2
18    TYPE data_type
19      SEQUENCE
20      PRIVATE
21      INTEGER :: I
22    END TYPE
23
24  CONTAINS
25
26    SUBROUTINE TEST(x)
27      TYPE(data_type) :: x
28    END SUBROUTINE TEST
29  END MODULE
30
31    USE T1
32    USE T2 , ONLY : TEST
33    TYPE(data_type) :: x
34    CALL TEST(x)         ! { dg-error "Type mismatch in argument" }
35  END
36