annotate gcc/testsuite/gfortran.dg/assumed_rank_9.f90 @ 132:d34655255c78

update gcc-8.2
author mir3636
date Thu, 25 Oct 2018 10:21:07 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! { dg-additional-sources assumed_rank_8_c.c }
kono
parents:
diff changeset
3 !
kono
parents:
diff changeset
4 ! PR fortran/48820
kono
parents:
diff changeset
5 !
kono
parents:
diff changeset
6 ! Scalars to assumed-rank tests
kono
parents:
diff changeset
7 !
kono
parents:
diff changeset
8 program main
kono
parents:
diff changeset
9 implicit none
kono
parents:
diff changeset
10
kono
parents:
diff changeset
11 type t
kono
parents:
diff changeset
12 integer :: i
kono
parents:
diff changeset
13 end type t
kono
parents:
diff changeset
14
kono
parents:
diff changeset
15 interface
kono
parents:
diff changeset
16 subroutine check (x)
kono
parents:
diff changeset
17 integer :: x(..)
kono
parents:
diff changeset
18 end subroutine check
kono
parents:
diff changeset
19 subroutine check2 (x)
kono
parents:
diff changeset
20 import t
kono
parents:
diff changeset
21 class(t) :: x(..)
kono
parents:
diff changeset
22 end subroutine check2
kono
parents:
diff changeset
23 end interface
kono
parents:
diff changeset
24
kono
parents:
diff changeset
25 integer :: j
kono
parents:
diff changeset
26
kono
parents:
diff changeset
27 type(t), target :: y
kono
parents:
diff changeset
28 class(t), allocatable, target :: yac
kono
parents:
diff changeset
29
kono
parents:
diff changeset
30 y%i = 489
kono
parents:
diff changeset
31 allocate (yac)
kono
parents:
diff changeset
32 yac%i = 489
kono
parents:
diff changeset
33 j = 0
kono
parents:
diff changeset
34 call fc()
kono
parents:
diff changeset
35 call fc(null())
kono
parents:
diff changeset
36 call fc(y)
kono
parents:
diff changeset
37 call fc(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
38 if (j /= 2) STOP 1
111
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 j = 0
kono
parents:
diff changeset
41 call gc(null())
kono
parents:
diff changeset
42 call gc(y)
kono
parents:
diff changeset
43 call gc(yac)
kono
parents:
diff changeset
44 deallocate (yac)
kono
parents:
diff changeset
45 call gc(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
46 if (j /= 2) STOP 2
111
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 j = 0
kono
parents:
diff changeset
49 call hc(yac)
kono
parents:
diff changeset
50 allocate (yac)
kono
parents:
diff changeset
51 yac%i = 489
kono
parents:
diff changeset
52 call hc(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
53 if (j /= 1) STOP 3
111
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 j = 0
kono
parents:
diff changeset
56 call ft()
kono
parents:
diff changeset
57 call ft(null())
kono
parents:
diff changeset
58 call ft(y)
kono
parents:
diff changeset
59 call ft(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
60 if (j /= 2) STOP 4
111
kono
parents:
diff changeset
61
kono
parents:
diff changeset
62 j = 0
kono
parents:
diff changeset
63 call gt(null())
kono
parents:
diff changeset
64 call gt(y)
kono
parents:
diff changeset
65 call gt(yac)
kono
parents:
diff changeset
66 deallocate (yac)
kono
parents:
diff changeset
67 call gt(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
68 if (j /= 2) STOP 5
111
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 j = 0
kono
parents:
diff changeset
71 call ht(yac)
kono
parents:
diff changeset
72 allocate (yac)
kono
parents:
diff changeset
73 yac%i = 489
kono
parents:
diff changeset
74 call ht(yac)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
75 if (j /= 1) STOP 6
111
kono
parents:
diff changeset
76
kono
parents:
diff changeset
77 contains
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 subroutine fc (x)
kono
parents:
diff changeset
80 class(t), optional :: x(..)
kono
parents:
diff changeset
81
kono
parents:
diff changeset
82 if (.not. present (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
83 if (.not. SAME_TYPE_AS (x, yac)) STOP 7
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
84 if (rank (x) /= 0) STOP 1
111
kono
parents:
diff changeset
85 call check2 (x)
kono
parents:
diff changeset
86 j = j + 1
kono
parents:
diff changeset
87 end subroutine
kono
parents:
diff changeset
88
kono
parents:
diff changeset
89 subroutine gc (x)
kono
parents:
diff changeset
90 class(t), pointer, intent(in) :: x(..)
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 if (.not. associated (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
93 if (.not. SAME_TYPE_AS (x, yac)) STOP 8
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
94 if (rank (x) /= 0) STOP 9
111
kono
parents:
diff changeset
95 call check2 (x)
kono
parents:
diff changeset
96 j = j + 1
kono
parents:
diff changeset
97 end subroutine
kono
parents:
diff changeset
98
kono
parents:
diff changeset
99 subroutine hc (x)
kono
parents:
diff changeset
100 class(t), allocatable :: x(..)
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 if (.not. allocated (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
103 if (.not. SAME_TYPE_AS (x, yac)) STOP 10
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
104 if (rank (x) /= 0) STOP 2
111
kono
parents:
diff changeset
105 call check2 (x)
kono
parents:
diff changeset
106 j = j + 1
kono
parents:
diff changeset
107 end subroutine
kono
parents:
diff changeset
108
kono
parents:
diff changeset
109 subroutine ft (x)
kono
parents:
diff changeset
110 type(t), optional :: x(..)
kono
parents:
diff changeset
111
kono
parents:
diff changeset
112 if (.not. present (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
113 if (.not. SAME_TYPE_AS (x, yac)) STOP 11
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
114 if (rank (x) /= 0) STOP 3
111
kono
parents:
diff changeset
115 call check2 (x)
kono
parents:
diff changeset
116 j = j + 1
kono
parents:
diff changeset
117 end subroutine
kono
parents:
diff changeset
118
kono
parents:
diff changeset
119 subroutine gt (x)
kono
parents:
diff changeset
120 type(t), pointer, intent(in) :: x(..)
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 if (.not. associated (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
123 if (.not. SAME_TYPE_AS (x, yac)) STOP 12
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
124 if (rank (x) /= 0) STOP 13
111
kono
parents:
diff changeset
125 call check2 (x)
kono
parents:
diff changeset
126 j = j + 1
kono
parents:
diff changeset
127 end subroutine
kono
parents:
diff changeset
128
kono
parents:
diff changeset
129 subroutine ht (x)
kono
parents:
diff changeset
130 type(t), allocatable :: x(..)
kono
parents:
diff changeset
131
kono
parents:
diff changeset
132 if (.not. allocated (x)) return
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
133 if (.not. SAME_TYPE_AS (x, yac)) STOP 14
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
134 if (rank (x) /= 0) STOP 4
111
kono
parents:
diff changeset
135 call check2 (x)
kono
parents:
diff changeset
136 j = j + 1
kono
parents:
diff changeset
137 end subroutine
kono
parents:
diff changeset
138
kono
parents:
diff changeset
139 end program main