Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/import.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ! { dg-do run } | |
2 ! Test whether import works | |
3 ! PR fortran/29601 | |
4 | |
5 subroutine test(x) | |
6 type myType3 | |
7 sequence | |
8 integer :: i | |
9 end type myType3 | |
10 type(myType3) :: x | |
11 if(x%i /= 7) call abort() | |
12 x%i = 1 | |
13 end subroutine test | |
14 | |
15 | |
16 subroutine bar(x,y) | |
17 type myType | |
18 sequence | |
19 integer :: i | |
20 end type myType | |
21 type(myType) :: x | |
22 integer(8) :: y | |
23 if(y /= 8) call abort() | |
24 if(x%i /= 2) call abort() | |
25 x%i = 5 | |
26 y = 42 | |
27 end subroutine bar | |
28 | |
29 module testmod | |
30 implicit none | |
31 integer, parameter :: kind = 8 | |
32 type modType | |
33 real :: rv | |
34 end type modType | |
35 interface | |
36 subroutine other(x,y) | |
37 import | |
38 real(kind) :: x | |
39 type(modType) :: y | |
40 end subroutine | |
41 end interface | |
42 end module testmod | |
43 | |
44 program foo | |
45 integer, parameter :: dp = 8 | |
46 type myType | |
47 sequence | |
48 integer :: i | |
49 end type myType | |
50 type myType3 | |
51 sequence | |
52 integer :: i | |
53 end type myType3 | |
54 interface | |
55 subroutine bar(x,y) | |
56 import | |
57 type(myType) :: x | |
58 integer(dp) :: y | |
59 end subroutine bar | |
60 subroutine test(x) | |
61 import :: myType3 | |
62 import myType3 ! { dg-warning "already IMPORTed from" } | |
63 type(myType3) :: x | |
64 end subroutine test | |
65 end interface | |
66 | |
67 type(myType) :: y | |
68 type(myType3) :: z | |
69 integer(8) :: i8 | |
70 y%i = 2 | |
71 i8 = 8 | |
72 call bar(y,i8) | |
73 if(y%i /= 5 .or. i8/= 42) call abort() | |
74 z%i = 7 | |
75 call test(z) | |
76 if(z%i /= 1) call abort() | |
77 end program foo |