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