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
6 +# Copyright 2014 Free Software Foundation, Inc.
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.
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.
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/>.
21 +standard_testfile ".f90"
23 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
24 + {debug f90 quiet}] } {
28 +if ![runto MAIN__] then {
29 + perror "couldn't run to breakpoint MAIN__"
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, .\]*\\)" \
38 +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
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)"
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"
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\\\)" \
57 +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
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
72 +! Copyright 2014 Free Software Foundation, Inc.
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.
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.
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.
88 +logical function func1 (vla)
90 + integer, allocatable :: vla (:, :)
91 + func1 = allocated(vla)
92 + vla(5,5) = 55 ! func1-vla-passed
94 + return ! func1-vla-modified
100 + integer :: func2(size(vla))
103 + vla(1) = 1 ! func2-vla-passed
114 + logical function func1 (vla)
115 + integer, allocatable :: vla (:, :)
119 + function func2 (vla)
121 + integer func2(size(vla))
126 + integer, allocatable :: vla1 (:, :)
127 + integer, allocatable :: vla2 (:)
128 + integer, allocatable :: vla3 (:)
132 + allocate (vla1 (10,10))
135 + allocate (vla2 (10))
139 + vla3 = func2(vla2) ! func1-returned
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
148 +# Copyright 2014 Free Software Foundation, Inc.
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.
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.
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/>.
163 +standard_testfile ".f90"
165 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
166 + {debug f90 quiet}] } {
170 +# check that all fortran standard datatypes will be
171 +# handled correctly when using as VLA's
173 +if ![runto MAIN__] then {
174 + perror "couldn't run to breakpoint MAIN__"
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"
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)"
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"
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"
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"
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
254 +! Copyright 2014 Free Software Foundation, Inc.
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.
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.
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.
271 + character(len=:), target, allocatable :: var_char
272 + character(len=:), pointer :: var_char_p
275 + allocate(character(len=10) :: var_char)
276 + l = allocated(var_char) ! var_char-allocated-1
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