Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc-8.2
author mir3636
date Thu, 25 Oct 2018 10:21:07 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
130:e108057fa461 132:d34655255c78
33 j = 0 33 j = 0
34 call fc() 34 call fc()
35 call fc(null()) 35 call fc(null())
36 call fc(y) 36 call fc(y)
37 call fc(yac) 37 call fc(yac)
38 if (j /= 2) call abort () 38 if (j /= 2) STOP 1
39 39
40 j = 0 40 j = 0
41 call gc(null()) 41 call gc(null())
42 call gc(y) 42 call gc(y)
43 call gc(yac) 43 call gc(yac)
44 deallocate (yac) 44 deallocate (yac)
45 call gc(yac) 45 call gc(yac)
46 if (j /= 2) call abort () 46 if (j /= 2) STOP 2
47 47
48 j = 0 48 j = 0
49 call hc(yac) 49 call hc(yac)
50 allocate (yac) 50 allocate (yac)
51 yac%i = 489 51 yac%i = 489
52 call hc(yac) 52 call hc(yac)
53 if (j /= 1) call abort () 53 if (j /= 1) STOP 3
54 54
55 j = 0 55 j = 0
56 call ft() 56 call ft()
57 call ft(null()) 57 call ft(null())
58 call ft(y) 58 call ft(y)
59 call ft(yac) 59 call ft(yac)
60 if (j /= 2) call abort () 60 if (j /= 2) STOP 4
61 61
62 j = 0 62 j = 0
63 call gt(null()) 63 call gt(null())
64 call gt(y) 64 call gt(y)
65 call gt(yac) 65 call gt(yac)
66 deallocate (yac) 66 deallocate (yac)
67 call gt(yac) 67 call gt(yac)
68 if (j /= 2) call abort () 68 if (j /= 2) STOP 5
69 69
70 j = 0 70 j = 0
71 call ht(yac) 71 call ht(yac)
72 allocate (yac) 72 allocate (yac)
73 yac%i = 489 73 yac%i = 489
74 call ht(yac) 74 call ht(yac)
75 if (j /= 1) call abort () 75 if (j /= 1) STOP 6
76 76
77 contains 77 contains
78 78
79 subroutine fc (x) 79 subroutine fc (x)
80 class(t), optional :: x(..) 80 class(t), optional :: x(..)
81 81
82 if (.not. present (x)) return 82 if (.not. present (x)) return
83 if (.not. SAME_TYPE_AS (x, yac)) call abort () 83 if (.not. SAME_TYPE_AS (x, yac)) STOP 7
84 if (rank (x) /= 0) call abort 84 if (rank (x) /= 0) STOP 1
85 call check2 (x) 85 call check2 (x)
86 j = j + 1 86 j = j + 1
87 end subroutine 87 end subroutine
88 88
89 subroutine gc (x) 89 subroutine gc (x)
90 class(t), pointer, intent(in) :: x(..) 90 class(t), pointer, intent(in) :: x(..)
91 91
92 if (.not. associated (x)) return 92 if (.not. associated (x)) return
93 if (.not. SAME_TYPE_AS (x, yac)) call abort () 93 if (.not. SAME_TYPE_AS (x, yac)) STOP 8
94 if (rank (x) /= 0) call abort () 94 if (rank (x) /= 0) STOP 9
95 call check2 (x) 95 call check2 (x)
96 j = j + 1 96 j = j + 1
97 end subroutine 97 end subroutine
98 98
99 subroutine hc (x) 99 subroutine hc (x)
100 class(t), allocatable :: x(..) 100 class(t), allocatable :: x(..)
101 101
102 if (.not. allocated (x)) return 102 if (.not. allocated (x)) return
103 if (.not. SAME_TYPE_AS (x, yac)) call abort () 103 if (.not. SAME_TYPE_AS (x, yac)) STOP 10
104 if (rank (x) /= 0) call abort 104 if (rank (x) /= 0) STOP 2
105 call check2 (x) 105 call check2 (x)
106 j = j + 1 106 j = j + 1
107 end subroutine 107 end subroutine
108 108
109 subroutine ft (x) 109 subroutine ft (x)
110 type(t), optional :: x(..) 110 type(t), optional :: x(..)
111 111
112 if (.not. present (x)) return 112 if (.not. present (x)) return
113 if (.not. SAME_TYPE_AS (x, yac)) call abort () 113 if (.not. SAME_TYPE_AS (x, yac)) STOP 11
114 if (rank (x) /= 0) call abort 114 if (rank (x) /= 0) STOP 3
115 call check2 (x) 115 call check2 (x)
116 j = j + 1 116 j = j + 1
117 end subroutine 117 end subroutine
118 118
119 subroutine gt (x) 119 subroutine gt (x)
120 type(t), pointer, intent(in) :: x(..) 120 type(t), pointer, intent(in) :: x(..)
121 121
122 if (.not. associated (x)) return 122 if (.not. associated (x)) return
123 if (.not. SAME_TYPE_AS (x, yac)) call abort () 123 if (.not. SAME_TYPE_AS (x, yac)) STOP 12
124 if (rank (x) /= 0) call abort () 124 if (rank (x) /= 0) STOP 13
125 call check2 (x) 125 call check2 (x)
126 j = j + 1 126 j = j + 1
127 end subroutine 127 end subroutine
128 128
129 subroutine ht (x) 129 subroutine ht (x)
130 type(t), allocatable :: x(..) 130 type(t), allocatable :: x(..)
131 131
132 if (.not. allocated (x)) return 132 if (.not. allocated (x)) return
133 if (.not. SAME_TYPE_AS (x, yac)) call abort () 133 if (.not. SAME_TYPE_AS (x, yac)) STOP 14
134 if (rank (x) /= 0) call abort 134 if (rank (x) /= 0) STOP 4
135 call check2 (x) 135 call check2 (x)
136 j = j + 1 136 j = j + 1
137 end subroutine 137 end subroutine
138 138
139 end program main 139 end program main