1# Copyright (C) 2008-2020 Free Software Foundation, Inc.
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
19load_lib gdb-guile.exp
20
21standard_testfile
22
23proc 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
158proc 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
165proc 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
172proc get_max_uint { size } {
173    return [expr "(1 << $size) - 1"]
174}
175
176# Helper routine for test_value_numeric_ranges.
177
178proc 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
192proc 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
214proc 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
240proc 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
256proc 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
295if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug c}]} {
296    return
297}
298
299# Skip all tests if Guile scripting is not enabled.
300if { [skip_guile_tests] } { continue }
301
302if ![gdb_guile_runto_main] {
303   return
304}
305
306test_value_numeric_ops
307test_value_numeric_ranges
308test_value_boolean
309test_value_compare
310