]>
Commit | Line | Data |
---|---|---|
4a94e368 | 1 | # Copyright (C) 2008-2022 Free Software Foundation, Inc. |
ed3ef339 DE |
2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | # This file is part of the GDB testsuite. | |
17 | # It tests <gdb:value> math operations. | |
18 | ||
19 | load_lib gdb-guile.exp | |
20 | ||
21 | standard_testfile | |
22 | ||
23 | proc test_value_numeric_ops {} { | |
24 | global gdb_prompt | |
25 | ||
26 | gdb_scm_test_silent_cmd "gu (define i (make-value 5))" \ | |
27 | "create first integer value" | |
28 | gdb_scm_test_silent_cmd "gu (define j (make-value 2))" \ | |
29 | "create second integer value" | |
30 | gdb_test "gu (print (value-add i j))" \ | |
31 | "= 7" "add two integer values" | |
32 | gdb_test "gu (raw-print (value-add i j))" \ | |
33 | "= #<gdb:value 7>" "verify type of integer add result" | |
34 | ||
35 | gdb_scm_test_silent_cmd "gu (define f (make-value 1.25))" \ | |
36 | "create first double value" | |
37 | gdb_scm_test_silent_cmd "gu (define g (make-value 2.5))" \ | |
38 | "create second double value" | |
39 | gdb_test "gu (print (value-add f g))" \ | |
40 | "= 3.75" "add two double values" | |
41 | gdb_test "gu (raw-print (value-add f g))" \ | |
42 | "= #<gdb:value 3.75>" "verify type of double add result" | |
43 | ||
44 | gdb_test "gu (print (value-sub i j))" \ | |
45 | "= 3" "subtract two integer values" | |
46 | gdb_test "gu (print (value-sub f g))" \ | |
47 | "= -1.25" "subtract two double values" | |
48 | ||
49 | gdb_test "gu (print (value-mul i j))" \ | |
50 | "= 10" "multiply two integer values" | |
51 | gdb_test "gu (print (value-mul f g))" \ | |
52 | "= 3.125" "multiply two double values" | |
53 | ||
54 | gdb_test "gu (print (value-div i j))" \ | |
55 | "= 2" "divide two integer values" | |
56 | gdb_test "gu (print (value-div f g))" \ | |
57 | "= 0.5" "divide two double values" | |
58 | gdb_test "gu (print (value-rem i j))" \ | |
59 | "= 1" "take remainder of two integer values" | |
60 | gdb_test "gu (print (value-mod i j))" \ | |
61 | "= 1" "take modulus of two integer values" | |
62 | ||
63 | gdb_test "gu (print (value-pow i j))" \ | |
64 | "= 25" "integer value raised to the power of another integer value" | |
65 | gdb_test "gu (print (value-pow g j))" \ | |
66 | "= 6.25" "double value raised to the power of integer value" | |
67 | ||
68 | gdb_test "gu (print (value-neg i))" \ | |
69 | "= -5" "negated integer value" | |
70 | gdb_test "gu (print (value-pos i))" \ | |
71 | "= 5" "positive integer value" | |
72 | gdb_test "gu (print (value-neg f))" \ | |
73 | "= -1.25" "negated double value" | |
74 | gdb_test "gu (print (value-pos f))" \ | |
75 | "= 1.25" "positive double value" | |
76 | gdb_test "gu (print (value-abs (value-sub j i)))" \ | |
77 | "= 3" "absolute of integer value" | |
78 | gdb_test "gu (print (value-abs (value-sub f g)))" \ | |
79 | "= 1.25" "absolute of double value" | |
80 | ||
81 | gdb_test "gu (print (value-lsh i j))" \ | |
82 | "= 20" "left shift" | |
83 | gdb_test "gu (print (value-rsh i j))" \ | |
84 | "= 1" "right shift" | |
85 | ||
86 | gdb_test "gu (print (value-min i j))" \ | |
87 | "= 2" "min" | |
88 | gdb_test "gu (print (value-max i j))" \ | |
89 | "= 5" "max" | |
90 | ||
91 | gdb_test "gu (print (value-lognot i))" \ | |
92 | "= -6" "lognot" | |
93 | gdb_test "gu (print (value-logand i j))" \ | |
94 | "= 0" "logand i j" | |
95 | gdb_test "gu (print (value-logand 5 1))" \ | |
96 | "= 1" "logand 5 1" | |
97 | gdb_test "gu (print (value-logior i j))" \ | |
98 | "= 7" "logior i j" | |
99 | gdb_test "gu (print (value-logior 5 1))" \ | |
100 | "= 5" "logior 5 1" | |
101 | gdb_test "gu (print (value-logxor i j))" \ | |
102 | "= 7" "logxor i j" | |
103 | gdb_test "gu (print (value-logxor 5 1))" \ | |
104 | "= 4" "logxor 5 1" | |
105 | ||
106 | # Test <gdb:value> mixed with Guile types. | |
107 | ||
108 | gdb_test "gu (print (value-sub i 1))" \ | |
109 | "= 4" "subtract integer value from guile integer" | |
110 | gdb_test "gu (raw-print (value-sub i 1))" \ | |
111 | "#<gdb:value 4>" \ | |
112 | "verify type of mixed integer subtraction result" | |
113 | gdb_test "gu (print (value-add f 1.5))" \ | |
114 | "= 2.75" "add double value with guile float" | |
115 | ||
116 | gdb_test "gu (print (value-sub 1 i))" \ | |
117 | "= -4" "subtract guile integer from integer value" | |
118 | gdb_test "gu (print (value-add 1.5 f))" \ | |
119 | "= 2.75" "add guile float with double value" | |
120 | ||
121 | # Enum conversion test. | |
122 | gdb_test "print evalue" "= TWO" | |
123 | gdb_test "gu (print (value->integer (history-ref 0)))" "= 2" | |
124 | ||
125 | # Test pointer arithmetic. | |
126 | ||
127 | # First, obtain the pointers. | |
128 | gdb_test "print (void *) 2" ".*" "" | |
129 | gdb_test_no_output "gu (define a (history-ref 0))" | |
130 | gdb_test "print (void *) 5" ".*" "" | |
131 | gdb_test_no_output "gu (define b (history-ref 0))" | |
132 | ||
133 | gdb_test "gu (print (value-add a 5))" \ | |
134 | "= 0x7( <.*>)?" "add pointer value with guile integer" | |
135 | gdb_test "gu (print (value-sub b 2))" \ | |
136 | "= 0x3( <.*>)?" "subtract guile integer from pointer value" | |
137 | gdb_test "gu (print (value-sub b a))" \ | |
138 | "= 3" "subtract two pointer values" | |
139 | ||
b5b591a8 GB |
140 | # Test pointer creation. |
141 | ||
142 | gdb_test_no_output "gu (define void-pointer-type (type-pointer (arch-void-type (current-arch))))" | |
143 | gdb_scm_test_silent_cmd "gu (define null-pointer (make-value 0 #:type void-pointer-type))" \ | |
144 | "test make-value with pointer type" | |
145 | gdb_test "gu (print null-pointer)" "= 0x0" | |
146 | gdb_test "gu (print (equal? (value-type null-pointer) void-pointer-type))" \ | |
147 | "= #t" | |
148 | ||
ed3ef339 DE |
149 | # Test some invalid operations. |
150 | ||
151 | gdb_test_multiple "gu (print (value-add i '()))" "catch error in guile type conversion" { | |
152 | -re "Wrong type argument in position 2.*$gdb_prompt $" {pass "catch error in guile type conversion"} | |
153 | -re "= .*$gdb_prompt $" {fail "catch error in guile type conversion"} | |
154 | -re "$gdb_prompt $" {fail "catch error in guile type conversion"} | |
155 | } | |
156 | ||
157 | gdb_test_multiple "gu (print (value-add i \"foo\"))" "catch throw of GDB error" { | |
158 | -re "Argument to arithmetic operation not a number or boolean.*$gdb_prompt $" {pass "catch throw of GDB error"} | |
159 | -re "= .*$gdb_prompt $" {fail "catch throw of GDB error"} | |
160 | -re "$gdb_prompt $" {fail "catch throw of GDB error"} | |
161 | } | |
162 | } | |
163 | ||
164 | # Return the max signed int of size SIZE. | |
165 | # TCL 8.5 required here. Use lookup table instead? | |
166 | ||
167 | proc get_max_int { size } { | |
168 | return [expr "(1 << ($size - 1)) - 1"] | |
169 | } | |
170 | ||
171 | # Return the min signed int of size SIZE. | |
172 | # TCL 8.5 required here. Use lookup table instead? | |
173 | ||
174 | proc get_min_int { size } { | |
175 | return [expr "-(1 << ($size - 1))"] | |
176 | } | |
177 | ||
178 | # Return the max unsigned int of size SIZE. | |
179 | # TCL 8.5 required here. Use lookup table instead? | |
180 | ||
181 | proc get_max_uint { size } { | |
182 | return [expr "(1 << $size) - 1"] | |
183 | } | |
184 | ||
185 | # Helper routine for test_value_numeric_ranges. | |
186 | ||
187 | proc test_make_int_value { name size } { | |
188 | set max [get_max_int $size] | |
189 | set min [get_min_int $size] | |
190 | set umax [get_max_uint $size] | |
191 | gdb_test "gu (print (value-type (make-value $max)))" \ | |
192 | "= $name" "test make-value $name $size max" | |
193 | gdb_test "gu (print (value-type (make-value $min)))" \ | |
194 | "= $name" "test make-value $name $size min" | |
195 | gdb_test "gu (print (value-type (make-value $umax)))" \ | |
196 | "= unsigned $name" "test make-value unsigned $name $size umax" | |
197 | } | |
198 | ||
199 | # Helper routine for test_value_numeric_ranges. | |
200 | ||
201 | proc test_make_typed_int_value { size } { | |
202 | set name "int$size" | |
203 | set uname "uint$size" | |
204 | set max [get_max_int $size] | |
205 | set min [get_min_int $size] | |
206 | set umax [get_max_uint $size] | |
207 | ||
208 | gdb_test "gu (print (make-value $max #:type (arch-${name}-type arch)))" \ | |
209 | "= $max" "test make-value $name $size max" | |
210 | gdb_test "gu (print (make-value $min #:type (arch-${name}-type arch)))" \ | |
211 | "= $min" "test make-value $name $size min" | |
212 | gdb_test "gu (print (make-value $umax #:type (arch-${uname}-type arch)))" \ | |
213 | "= $umax" "test make-value $uname $size umax" | |
214 | ||
215 | gdb_test "gu (print (make-value (+ $max 1) #:type (arch-${name}-type arch)))" \ | |
216 | "ERROR.*Out of range.*" "test make-value $name $size max+1" | |
217 | gdb_test "gu (print (make-value (- $min 1) #:type (arch-${name}-type arch)))" \ | |
218 | "ERROR.*Out of range.*" "test make-value $name $size min-1" | |
219 | gdb_test "gu (print (make-value (+ $umax 1) #:type (arch-${uname}-type arch)))" \ | |
220 | "ERROR.*Out of range.*" "test make-value $uname $size umax+1" | |
221 | } | |
222 | ||
223 | proc test_value_numeric_ranges {} { | |
224 | # We can't assume anything about sizeof (int), etc. on the target. | |
225 | # Keep it simple for now, this will cover everything important for | |
226 | # the major targets. | |
227 | set int_size [get_sizeof "int" 0] | |
228 | set long_size [get_sizeof "long" 0] | |
229 | gdb_test_no_output "gu (define arch (current-arch))" | |
230 | ||
231 | if { $int_size == 4 } { | |
232 | test_make_int_value int 32 | |
233 | } | |
234 | if { $long_size == 8} { | |
235 | test_make_int_value long 64 | |
236 | } | |
237 | gdb_test "gu (print (value-type (make-value (ash 1 64))))" \ | |
238 | "ERROR:.*value not a number representable.*" \ | |
239 | "test make-value, number too large" | |
240 | ||
241 | foreach size { 8 16 32 } { | |
242 | test_make_typed_int_value $size | |
243 | } | |
244 | if { $long_size == 8 } { | |
245 | test_make_typed_int_value 64 | |
246 | } | |
247 | } | |
248 | ||
b5b591a8 GB |
249 | # Helper routine for test_pointer_numeric_range. |
250 | ||
251 | proc test_make_pointer_value { size } { | |
252 | set max [get_max_uint $size] | |
253 | set max_hex [string repeat "f" [expr "$size / 4"]] | |
254 | ||
255 | gdb_test "gu (print (make-value $max #:type void-pointer-type))" \ | |
256 | "= 0x$max_hex" "test make-value void* max" | |
257 | gdb_test "gu (print (make-value 0 #:type void-pointer-type))" \ | |
258 | "= 0x0" "test make-value void* 0" | |
259 | ||
260 | gdb_test "gu (print (make-value (+ $max 1) #:type void-pointer-type))" \ | |
261 | "ERROR.*Out of range.*" "test make-value void* max+1" | |
262 | gdb_test "gu (print (make-value -1 #:type void-pointer-type))" \ | |
263 | "ERROR.*Out of range.*" "test make-value void* -1" | |
264 | } | |
265 | ||
266 | proc test_pointer_numeric_range {} { | |
267 | # We can't assume anything about sizeof (void*) on the target. | |
268 | # Keep it simple for now, this will cover everything important for | |
269 | # the major targets. | |
270 | set pointer_size [get_sizeof "void*" 0] | |
271 | if { $pointer_size == 4 } { | |
272 | test_make_pointer_value 32 | |
273 | } | |
274 | if { $pointer_size == 8 } { | |
275 | test_make_pointer_value 64 | |
276 | } | |
277 | } | |
278 | ||
ed3ef339 DE |
279 | proc test_value_boolean {} { |
280 | # Note: Boolean values print as 0,1 because they are printed in the | |
281 | # current language (in this case C). | |
282 | ||
283 | gdb_test "gu (print (make-value #t))" "= 1" "create boolean true" | |
284 | gdb_test "gu (print (make-value #f))" "= 0" "create boolean false" | |
285 | ||
286 | gdb_test "gu (print (value-not (make-value #t)))" \ | |
287 | "= 0" "not true" | |
288 | gdb_test "gu (print (value-not (make-value #f)))" \ | |
289 | "= 1" "not false" | |
290 | ||
291 | gdb_test "gu (raw-print (make-value #t))" \ | |
292 | "#<gdb:value 1>" "verify type of boolean" | |
293 | } | |
294 | ||
295 | proc test_value_compare {} { | |
296 | gdb_test "gu (print (value<? 1 1))" \ | |
297 | "#f" "less than, equal" | |
298 | gdb_test "gu (print (value<? 1 2))" \ | |
299 | "#t" "less than, less" | |
300 | gdb_test "gu (print (value<? 2 1))" \ | |
301 | "#f" "less than, greater" | |
302 | ||
303 | gdb_test "gu (print (value<=? 1 1))" \ | |
304 | "#t" "less or equal, equal" | |
305 | gdb_test "gu (print (value<=? 1 2))" \ | |
306 | "#t" "less or equal, less" | |
307 | gdb_test "gu (print (value<=? 2 1))" \ | |
308 | "#f" "less or equal, greater" | |
309 | ||
310 | gdb_test "gu (print (value=? 1 1))" \ | |
311 | "#t" "equality" | |
312 | gdb_test "gu (print (value=? 1 2))" \ | |
313 | "#f" "inequality" | |
314 | gdb_test "gu (print (value=? (make-value 1) 1.0))" \ | |
315 | "#t" "equality of gdb:value with Guile value" | |
316 | gdb_test "gu (print (value=? (make-value 1) 2))" \ | |
317 | "#f" "inequality of gdb:value with Guile value" | |
318 | ||
319 | gdb_test "gu (print (value>? 1 1))" \ | |
320 | "#f" "greater than, equal" | |
321 | gdb_test "gu (print (value>? 1 2))" \ | |
322 | "#f" "greater than, less" | |
323 | gdb_test "gu (print (value>? 2 1))" \ | |
324 | "#t" "greater than, greater" | |
325 | ||
326 | gdb_test "gu (print (value>=? 1 1))" \ | |
327 | "#t" "greater or equal, equal" | |
328 | gdb_test "gu (print (value>=? 1 2))" \ | |
329 | "#f" "greater or equal, less" | |
330 | gdb_test "gu (print (value>=? 2 1))" \ | |
331 | "#t" "greater or equal, greater" | |
332 | } | |
333 | ||
5b362f04 | 334 | if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug c}]} { |
ed3ef339 DE |
335 | return |
336 | } | |
337 | ||
338 | # Skip all tests if Guile scripting is not enabled. | |
339 | if { [skip_guile_tests] } { continue } | |
340 | ||
341 | if ![gdb_guile_runto_main] { | |
342 | return | |
343 | } | |
344 | ||
345 | test_value_numeric_ops | |
346 | test_value_numeric_ranges | |
b5b591a8 | 347 | test_pointer_numeric_range |
ed3ef339 DE |
348 | test_value_boolean |
349 | test_value_compare |