Commit | Line | Data |
---|---|---|
32d0add0 | 1 | # Copyright (C) 2008-2015 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 | ||
140 | # Test some invalid operations. | |
141 | ||
142 | gdb_test_multiple "gu (print (value-add i '()))" "catch error in guile type conversion" { | |
143 | -re "Wrong type argument in position 2.*$gdb_prompt $" {pass "catch error in guile type conversion"} | |
144 | -re "= .*$gdb_prompt $" {fail "catch error in guile type conversion"} | |
145 | -re "$gdb_prompt $" {fail "catch error in guile type conversion"} | |
146 | } | |
147 | ||
148 | gdb_test_multiple "gu (print (value-add i \"foo\"))" "catch throw of GDB error" { | |
149 | -re "Argument to arithmetic operation not a number or boolean.*$gdb_prompt $" {pass "catch throw of GDB error"} | |
150 | -re "= .*$gdb_prompt $" {fail "catch throw of GDB error"} | |
151 | -re "$gdb_prompt $" {fail "catch throw of GDB error"} | |
152 | } | |
153 | } | |
154 | ||
155 | # Return the max signed int of size SIZE. | |
156 | # TCL 8.5 required here. Use lookup table instead? | |
157 | ||
158 | proc get_max_int { size } { | |
159 | return [expr "(1 << ($size - 1)) - 1"] | |
160 | } | |
161 | ||
162 | # Return the min signed int of size SIZE. | |
163 | # TCL 8.5 required here. Use lookup table instead? | |
164 | ||
165 | proc get_min_int { size } { | |
166 | return [expr "-(1 << ($size - 1))"] | |
167 | } | |
168 | ||
169 | # Return the max unsigned int of size SIZE. | |
170 | # TCL 8.5 required here. Use lookup table instead? | |
171 | ||
172 | proc get_max_uint { size } { | |
173 | return [expr "(1 << $size) - 1"] | |
174 | } | |
175 | ||
176 | # Helper routine for test_value_numeric_ranges. | |
177 | ||
178 | proc test_make_int_value { name size } { | |
179 | set max [get_max_int $size] | |
180 | set min [get_min_int $size] | |
181 | set umax [get_max_uint $size] | |
182 | gdb_test "gu (print (value-type (make-value $max)))" \ | |
183 | "= $name" "test make-value $name $size max" | |
184 | gdb_test "gu (print (value-type (make-value $min)))" \ | |
185 | "= $name" "test make-value $name $size min" | |
186 | gdb_test "gu (print (value-type (make-value $umax)))" \ | |
187 | "= unsigned $name" "test make-value unsigned $name $size umax" | |
188 | } | |
189 | ||
190 | # Helper routine for test_value_numeric_ranges. | |
191 | ||
192 | proc test_make_typed_int_value { size } { | |
193 | set name "int$size" | |
194 | set uname "uint$size" | |
195 | set max [get_max_int $size] | |
196 | set min [get_min_int $size] | |
197 | set umax [get_max_uint $size] | |
198 | ||
199 | gdb_test "gu (print (make-value $max #:type (arch-${name}-type arch)))" \ | |
200 | "= $max" "test make-value $name $size max" | |
201 | gdb_test "gu (print (make-value $min #:type (arch-${name}-type arch)))" \ | |
202 | "= $min" "test make-value $name $size min" | |
203 | gdb_test "gu (print (make-value $umax #:type (arch-${uname}-type arch)))" \ | |
204 | "= $umax" "test make-value $uname $size umax" | |
205 | ||
206 | gdb_test "gu (print (make-value (+ $max 1) #:type (arch-${name}-type arch)))" \ | |
207 | "ERROR.*Out of range.*" "test make-value $name $size max+1" | |
208 | gdb_test "gu (print (make-value (- $min 1) #:type (arch-${name}-type arch)))" \ | |
209 | "ERROR.*Out of range.*" "test make-value $name $size min-1" | |
210 | gdb_test "gu (print (make-value (+ $umax 1) #:type (arch-${uname}-type arch)))" \ | |
211 | "ERROR.*Out of range.*" "test make-value $uname $size umax+1" | |
212 | } | |
213 | ||
214 | proc test_value_numeric_ranges {} { | |
215 | # We can't assume anything about sizeof (int), etc. on the target. | |
216 | # Keep it simple for now, this will cover everything important for | |
217 | # the major targets. | |
218 | set int_size [get_sizeof "int" 0] | |
219 | set long_size [get_sizeof "long" 0] | |
220 | gdb_test_no_output "gu (define arch (current-arch))" | |
221 | ||
222 | if { $int_size == 4 } { | |
223 | test_make_int_value int 32 | |
224 | } | |
225 | if { $long_size == 8} { | |
226 | test_make_int_value long 64 | |
227 | } | |
228 | gdb_test "gu (print (value-type (make-value (ash 1 64))))" \ | |
229 | "ERROR:.*value not a number representable.*" \ | |
230 | "test make-value, number too large" | |
231 | ||
232 | foreach size { 8 16 32 } { | |
233 | test_make_typed_int_value $size | |
234 | } | |
235 | if { $long_size == 8 } { | |
236 | test_make_typed_int_value 64 | |
237 | } | |
238 | } | |
239 | ||
240 | proc test_value_boolean {} { | |
241 | # Note: Boolean values print as 0,1 because they are printed in the | |
242 | # current language (in this case C). | |
243 | ||
244 | gdb_test "gu (print (make-value #t))" "= 1" "create boolean true" | |
245 | gdb_test "gu (print (make-value #f))" "= 0" "create boolean false" | |
246 | ||
247 | gdb_test "gu (print (value-not (make-value #t)))" \ | |
248 | "= 0" "not true" | |
249 | gdb_test "gu (print (value-not (make-value #f)))" \ | |
250 | "= 1" "not false" | |
251 | ||
252 | gdb_test "gu (raw-print (make-value #t))" \ | |
253 | "#<gdb:value 1>" "verify type of boolean" | |
254 | } | |
255 | ||
256 | proc test_value_compare {} { | |
257 | gdb_test "gu (print (value<? 1 1))" \ | |
258 | "#f" "less than, equal" | |
259 | gdb_test "gu (print (value<? 1 2))" \ | |
260 | "#t" "less than, less" | |
261 | gdb_test "gu (print (value<? 2 1))" \ | |
262 | "#f" "less than, greater" | |
263 | ||
264 | gdb_test "gu (print (value<=? 1 1))" \ | |
265 | "#t" "less or equal, equal" | |
266 | gdb_test "gu (print (value<=? 1 2))" \ | |
267 | "#t" "less or equal, less" | |
268 | gdb_test "gu (print (value<=? 2 1))" \ | |
269 | "#f" "less or equal, greater" | |
270 | ||
271 | gdb_test "gu (print (value=? 1 1))" \ | |
272 | "#t" "equality" | |
273 | gdb_test "gu (print (value=? 1 2))" \ | |
274 | "#f" "inequality" | |
275 | gdb_test "gu (print (value=? (make-value 1) 1.0))" \ | |
276 | "#t" "equality of gdb:value with Guile value" | |
277 | gdb_test "gu (print (value=? (make-value 1) 2))" \ | |
278 | "#f" "inequality of gdb:value with Guile value" | |
279 | ||
280 | gdb_test "gu (print (value>? 1 1))" \ | |
281 | "#f" "greater than, equal" | |
282 | gdb_test "gu (print (value>? 1 2))" \ | |
283 | "#f" "greater than, less" | |
284 | gdb_test "gu (print (value>? 2 1))" \ | |
285 | "#t" "greater than, greater" | |
286 | ||
287 | gdb_test "gu (print (value>=? 1 1))" \ | |
288 | "#t" "greater or equal, equal" | |
289 | gdb_test "gu (print (value>=? 1 2))" \ | |
290 | "#f" "greater or equal, less" | |
291 | gdb_test "gu (print (value>=? 2 1))" \ | |
292 | "#t" "greater or equal, greater" | |
293 | } | |
294 | ||
295 | if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug c}]} { | |
296 | return | |
297 | } | |
298 | ||
299 | # Skip all tests if Guile scripting is not enabled. | |
300 | if { [skip_guile_tests] } { continue } | |
301 | ||
302 | if ![gdb_guile_runto_main] { | |
303 | return | |
304 | } | |
305 | ||
306 | test_value_numeric_ops | |
307 | test_value_numeric_ranges | |
308 | test_value_boolean | |
309 | test_value_compare |