]>
Commit | Line | Data |
---|---|---|
140f8057 JR |
1 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp |
2 | =================================================================== | |
3 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
4 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp 2016-01-08 19:15:44.983637680 +0100 | |
5 | @@ -0,0 +1,61 @@ | |
6 | +# Copyright 2014 Free Software Foundation, Inc. | |
7 | + | |
8 | +# This program is free software; you can redistribute it and/or modify | |
9 | +# it under the terms of the GNU General Public License as published by | |
10 | +# the Free Software Foundation; either version 3 of the License, or | |
11 | +# (at your option) any later version. | |
12 | +# | |
13 | +# This program is distributed in the hope that it will be useful, | |
14 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | +# GNU General Public License for more details. | |
17 | +# | |
18 | +# You should have received a copy of the GNU General Public License | |
19 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
20 | + | |
21 | +standard_testfile ".f90" | |
22 | + | |
23 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
24 | + {debug f90 quiet}] } { | |
25 | + return -1 | |
26 | +} | |
27 | + | |
28 | +if ![runto MAIN__] then { | |
29 | + perror "couldn't run to breakpoint MAIN__" | |
30 | + continue | |
31 | +} | |
32 | + | |
33 | +# Check VLA passed to first Fortran function. | |
34 | +gdb_breakpoint [gdb_get_line_number "func1-vla-passed"] | |
35 | +gdb_continue_to_breakpoint "func1-vla-passed" | |
36 | +gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \ | |
37 | + "print vla (func1)" | |
38 | +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \ | |
39 | + "ptype vla (func1)" | |
40 | + | |
41 | +gdb_breakpoint [gdb_get_line_number "func1-vla-modified"] | |
42 | +gdb_continue_to_breakpoint "func1-vla-modified" | |
43 | +gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)" | |
44 | +gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)" | |
45 | + | |
46 | +# Check if the values are correct after returning from func1 | |
47 | +gdb_breakpoint [gdb_get_line_number "func1-returned"] | |
48 | +gdb_continue_to_breakpoint "func1-returned" | |
49 | +gdb_test "print ret" " = .TRUE." "print ret after func1 returned" | |
50 | + | |
51 | +# Check VLA passed to second Fortran function | |
52 | +gdb_breakpoint [gdb_get_line_number "func2-vla-passed"] | |
53 | +gdb_continue_to_breakpoint "func2-vla-passed" | |
54 | +gdb_test "print vla" \ | |
55 | + " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \ | |
56 | + "print vla (func2)" | |
57 | +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \ | |
58 | + "ptype vla (func2)" | |
59 | + | |
60 | +# Check if the returned VLA has the correct values and ptype. | |
61 | +gdb_breakpoint [gdb_get_line_number "func2-returned"] | |
62 | +gdb_continue_to_breakpoint "func2-returned" | |
63 | +gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \ | |
64 | + "print vla3 (after func2)" | |
65 | +gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \ | |
66 | + "ptype vla3 (after func2)" | |
67 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 | |
68 | =================================================================== | |
69 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
70 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 2016-01-08 19:15:44.983637680 +0100 | |
71 | @@ -0,0 +1,71 @@ | |
72 | +! Copyright 2014 Free Software Foundation, Inc. | |
73 | +! | |
74 | +! This program is free software; you can redistribute it and/or modify | |
75 | +! it under the terms of the GNU General Public License as published by | |
76 | +! the Free Software Foundation; either version 2 of the License, or | |
77 | +! (at your option) any later version. | |
78 | +! | |
79 | +! This program is distributed in the hope that it will be useful, | |
80 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
81 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
82 | +! GNU General Public License for more details. | |
83 | +! | |
84 | +! You should have received a copy of the GNU General Public License | |
85 | +! along with this program; if not, write to the Free Software | |
86 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
87 | + | |
88 | +logical function func1 (vla) | |
89 | + implicit none | |
90 | + integer, allocatable :: vla (:, :) | |
91 | + func1 = allocated(vla) | |
92 | + vla(5,5) = 55 ! func1-vla-passed | |
93 | + vla(7,7) = 77 | |
94 | + return ! func1-vla-modified | |
95 | +end function func1 | |
96 | + | |
97 | +function func2(vla) | |
98 | + implicit none | |
99 | + integer :: vla (:) | |
100 | + integer :: func2(size(vla)) | |
101 | + integer :: k | |
102 | + | |
103 | + vla(1) = 1 ! func2-vla-passed | |
104 | + vla(2) = 2 | |
105 | + vla(4) = 4 | |
106 | + vla(8) = 8 | |
107 | + | |
108 | + func2 = vla | |
109 | +end function func2 | |
110 | + | |
111 | +program vla_func | |
112 | + implicit none | |
113 | + interface | |
114 | + logical function func1 (vla) | |
115 | + integer, allocatable :: vla (:, :) | |
116 | + end function | |
117 | + end interface | |
118 | + interface | |
119 | + function func2 (vla) | |
120 | + integer :: vla (:) | |
121 | + integer func2(size(vla)) | |
122 | + end function | |
123 | + end interface | |
124 | + | |
125 | + logical :: ret | |
126 | + integer, allocatable :: vla1 (:, :) | |
127 | + integer, allocatable :: vla2 (:) | |
128 | + integer, allocatable :: vla3 (:) | |
129 | + | |
130 | + ret = .FALSE. | |
131 | + | |
132 | + allocate (vla1 (10,10)) | |
133 | + vla1(:,:) = 22 | |
134 | + | |
135 | + allocate (vla2 (10)) | |
136 | + vla2(:) = 44 | |
137 | + | |
138 | + ret = func1(vla1) | |
139 | + vla3 = func2(vla2) ! func1-returned | |
140 | + | |
141 | + ret = .TRUE. ! func2-returned | |
142 | +end program vla_func | |
143 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.exp | |
144 | =================================================================== | |
145 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
146 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.exp 2016-01-08 19:15:44.984637686 +0100 | |
147 | @@ -0,0 +1,101 @@ | |
148 | +# Copyright 2014 Free Software Foundation, Inc. | |
149 | + | |
150 | +# This program is free software; you can redistribute it and/or modify | |
151 | +# it under the terms of the GNU General Public License as published by | |
152 | +# the Free Software Foundation; either version 3 of the License, or | |
153 | +# (at your option) any later version. | |
154 | +# | |
155 | +# This program is distributed in the hope that it will be useful, | |
156 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
157 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
158 | +# GNU General Public License for more details. | |
159 | +# | |
160 | +# You should have received a copy of the GNU General Public License | |
161 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
162 | + | |
163 | +standard_testfile ".f90" | |
164 | + | |
165 | +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
166 | + {debug f90 quiet}] } { | |
167 | + return -1 | |
168 | +} | |
169 | + | |
170 | +# check that all fortran standard datatypes will be | |
171 | +# handled correctly when using as VLA's | |
172 | + | |
173 | +if ![runto MAIN__] then { | |
174 | + perror "couldn't run to breakpoint MAIN__" | |
175 | + continue | |
176 | +} | |
177 | + | |
178 | +gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"] | |
179 | +gdb_continue_to_breakpoint "var_char-allocated-1" | |
180 | +gdb_test "print var_char" \ | |
181 | + " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \ | |
182 | + "print var_char after allocated first time" | |
183 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \ | |
184 | + "whatis var_char first time" | |
185 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \ | |
186 | + "ptype var_char first time" | |
187 | +gdb_test "next" "\\d+.*var_char = 'foo'.*" \ | |
188 | + "next to allocation status of var_char" | |
189 | +gdb_test "print l" " = .TRUE." "print allocation status first time" | |
190 | + | |
191 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-1"] | |
192 | +gdb_continue_to_breakpoint "var_char-filled-1" | |
193 | +gdb_test "print var_char" \ | |
194 | + " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \ | |
195 | + "print var_char after filled first time" | |
196 | +gdb_test "print *var_char" " = 'foo'" \ | |
197 | + "print *var_char after filled first time" | |
198 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \ | |
199 | + "whatis var_char after filled first time" | |
200 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \ | |
201 | + "ptype var_char after filled first time" | |
202 | +gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)" | |
203 | +gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)" | |
204 | + | |
205 | +gdb_breakpoint [gdb_get_line_number "var_char-filled-2"] | |
206 | +gdb_continue_to_breakpoint "var_char-filled-2" | |
207 | +gdb_test "print var_char" \ | |
208 | + " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \ | |
209 | + "print var_char after allocated second time" | |
210 | +gdb_test "print *var_char" " = 'foobar'" \ | |
211 | + "print *var_char after allocated second time" | |
212 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \ | |
213 | + "whatis var_char second time" | |
214 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \ | |
215 | + "ptype var_char second time" | |
216 | + | |
217 | +gdb_breakpoint [gdb_get_line_number "var_char-empty"] | |
218 | +gdb_continue_to_breakpoint "var_char-empty" | |
219 | +gdb_test "print var_char" \ | |
220 | + " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \ | |
221 | + "print var_char after set empty" | |
222 | +gdb_test "print *var_char" " = \"\"" "print *var_char after set empty" | |
223 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \ | |
224 | + "whatis var_char after set empty" | |
225 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \ | |
226 | + "ptype var_char after set empty" | |
227 | + | |
228 | +gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"] | |
229 | +gdb_continue_to_breakpoint "var_char-allocated-3" | |
230 | +gdb_test "print var_char" \ | |
231 | + " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \ | |
232 | + "print var_char after allocated third time" | |
233 | +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \ | |
234 | + "whatis var_char after allocated third time" | |
235 | +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \ | |
236 | + "ptype var_char after allocated third time" | |
237 | + | |
238 | +gdb_breakpoint [gdb_get_line_number "var_char_p-associated"] | |
239 | +gdb_continue_to_breakpoint "var_char_p-associated" | |
240 | +gdb_test "print var_char_p" \ | |
241 | + " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \ | |
242 | + "print var_char_p after associated" | |
243 | +gdb_test "print *var_char_p" " = 'johndoe'" \ | |
244 | + "print *var_char_ after associated" | |
245 | +gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \ | |
246 | + "whatis var_char_p after associated" | |
247 | +gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \ | |
248 | + "ptype var_char_p after associated" | |
249 | Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.f90 | |
250 | =================================================================== | |
251 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
252 | +++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.f90 2016-01-08 19:15:44.984637686 +0100 | |
253 | @@ -0,0 +1,40 @@ | |
254 | +! Copyright 2014 Free Software Foundation, Inc. | |
255 | +! | |
256 | +! This program is free software; you can redistribute it and/or modify | |
257 | +! it under the terms of the GNU General Public License as published by | |
258 | +! the Free Software Foundation; either version 2 of the License, or | |
259 | +! (at your option) any later version. | |
260 | +! | |
261 | +! This program is distributed in the hope that it will be useful, | |
262 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
263 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
264 | +! GNU General Public License for more details. | |
265 | +! | |
266 | +! You should have received a copy of the GNU General Public License | |
267 | +! along with this program; if not, write to the Free Software | |
268 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
269 | + | |
270 | +program vla_strings | |
271 | + character(len=:), target, allocatable :: var_char | |
272 | + character(len=:), pointer :: var_char_p | |
273 | + logical :: l | |
274 | + | |
275 | + allocate(character(len=10) :: var_char) | |
276 | + l = allocated(var_char) ! var_char-allocated-1 | |
277 | + var_char = 'foo' | |
278 | + deallocate(var_char) ! var_char-filled-1 | |
279 | + l = allocated(var_char) ! var_char-deallocated | |
280 | + allocate(character(len=42) :: var_char) | |
281 | + l = allocated(var_char) | |
282 | + var_char = 'foobar' | |
283 | + var_char = '' ! var_char-filled-2 | |
284 | + var_char = 'bar' ! var_char-empty | |
285 | + deallocate(var_char) | |
286 | + allocate(character(len=21) :: var_char) | |
287 | + l = allocated(var_char) ! var_char-allocated-3 | |
288 | + var_char = 'johndoe' | |
289 | + var_char_p => var_char | |
290 | + l = associated(var_char_p) ! var_char_p-associated | |
291 | + var_char_p => null() | |
292 | + l = associated(var_char_p) ! var_char_p-not-associated | |
293 | +end program vla_strings |