OSDN Git Service

gcc/fortran:
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / import4.f90
1 ! { dg-do run }
2 ! Test for import in modules
3 ! PR fortran/29601
4
5 subroutine bar(r)
6   implicit none
7   integer(8) :: r
8   if(r /= 42) call abort()
9   r = 13
10 end subroutine bar
11
12 subroutine 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") call abort()
20   a%c = "abc"
21 end subroutine
22
23 subroutine 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) call abort()
32   a = -123.0
33   b%c = -44
34 end subroutine new
35
36 module general
37   implicit none
38   integer,parameter :: ikind = 8
39   type gType
40      sequence
41      integer(ikind) :: c
42   end type gType
43 end module general
44
45 module 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) call abort()
74   end subroutine test
75   subroutine test2()
76     type(myT) :: z
77     z%c = "xyz"
78     call foo(z)
79     if(z%c /= "abc") call abort()
80   end subroutine test2
81 end module modtest
82
83 program all
84   use modtest
85   implicit none
86   call test()
87   call test2()
88   call test3()
89 contains
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) call abort()
97   end subroutine test3
98 end program all
99 ! { dg-final { cleanup-modules "modtest general" } }