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