1! { dg-do run }
2! Test for import in modules
3! PR fortran/29601
4
5subroutine bar(r)
6  implicit none
7  integer(8) :: r
8  if(r /= 42) STOP 1
9  r = 13
10end subroutine bar
11
12subroutine foo(a)
13  implicit none
14  type myT
15     sequence
16     character(len=3) :: c
17  end type myT
18  type(myT) :: a
19  if(a%c /= "xyz") STOP 2
20  a%c = "abc"
21end subroutine
22
23subroutine new(a,b)
24  implicit none
25  type gType
26     sequence
27     integer(8) :: c
28  end type gType
29  real(8) :: a
30  type(gType) :: b
31  if(a /= 99.0 .or. b%c /= 11) STOP 3
32  a = -123.0
33  b%c = -44
34end subroutine new
35
36module general
37  implicit none
38  integer,parameter :: ikind = 8
39  type gType
40     sequence
41     integer(ikind) :: c
42  end type gType
43end module general
44
45module modtest
46  use general
47  implicit none
48  type myT
49     sequence
50     character(len=3) :: c
51  end type myT
52  integer, parameter :: dp = 8
53  interface
54     subroutine bar(x)
55       import :: dp
56       integer(dp) :: x
57     end subroutine bar
58     subroutine foo(c)
59      import :: myT
60       type(myT) :: c
61     end subroutine foo
62     subroutine new(x,y)
63      import :: ikind,gType
64      real(ikind) :: x
65      type(gType) :: y
66     end subroutine new
67  end interface
68  contains
69  subroutine test
70    integer(dp) :: y
71    y = 42
72    call bar(y)
73    if(y /= 13) STOP 4
74  end subroutine test
75  subroutine test2()
76    type(myT) :: z
77    z%c = "xyz"
78    call foo(z)
79    if(z%c /= "abc") STOP 5
80  end subroutine test2
81end module modtest
82
83program all
84  use modtest
85  implicit none
86  call test()
87  call test2()
88  call test3()
89contains
90  subroutine test3()
91    real(ikind) :: r
92    type(gType) :: t
93    r   = 99.0
94    t%c = 11
95    call new(r,t)
96    if(r /= -123.0 .or. t%c /= -44) STOP 6
97  end subroutine test3
98end program all
99