1! { dg-do compile }
2! Tests the fix for a further regression caused by the
3! fix for PR28788, as noted in reply #13 in the Bugzilla
4! entry by Martin Tee  <aovb94@dsl.pipex.com>.
5! The problem was caused by contained, use associated
6! derived types with pointer components of a derived type
7! use associated in a sibling procedure, where both are
8! associated by an ONLY clause. This is the reporter's
9! test case.
10!
11MODULE type_mod
12  TYPE a
13    INTEGER  :: n(10)
14  END TYPE a
15
16  TYPE b
17    TYPE (a), POINTER :: m(:) => NULL ()
18  END TYPE b
19END MODULE type_mod
20
21MODULE seg_mod
22CONTAINS
23  SUBROUTINE foo (x)
24    USE type_mod, ONLY : a     ! failed
25    IMPLICIT NONE
26    TYPE (a)  :: x
27    RETURN
28  END SUBROUTINE foo
29
30  SUBROUTINE bar (x)
31    USE type_mod, ONLY : b     ! failed
32    IMPLICIT NONE
33    TYPE (b)  :: x
34    RETURN
35  END SUBROUTINE bar
36END MODULE seg_mod
37