1! { dg-do compile }
2
3module implicit_2
4  ! This should cause an error if function types are resolved from the
5  ! module namespace.
6  implicit none
7  type t
8    integer i
9  end type
10contains
11! This caused an ICE because we were trying to apply the implicit type
12! after we had applied the explicit type.
13subroutine test()
14  implicit type (t) (v)
15  type (t) v1, v2
16  v1%i = 1
17  call foo (v2%i)
18end subroutine
19
20! A similar error because we failed to apply the implicit type to a function.
21! This is a contained function to check we lookup the type in the function
22! namespace, not it's parent.
23function f() result (val)
24  implicit type (t) (v)
25
26  val%i = 1
27end function
28
29! And again for a result variable.
30function fun()
31  implicit type (t) (f)
32
33  fun%i = 1
34end function
35
36! intrinsic types are resolved later than derived type, so check those as well.
37function test2()
38  implicit integer (t)
39  test2 = 42
40end function
41subroutine bar()
42  ! Check that implicit types are applied to names already known to be
43  ! variables.
44  implicit type(t) (v)
45  save v
46  v%i = 42
47end subroutine
48end module
49