| # Copyright (C) 2008-2014 Free Software Foundation, Inc. |
| |
| # This program is free software; you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 3 of the License, or |
| # (at your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| |
| # This file is part of the GDB testsuite. |
| # It tests <gdb:value> math operations. |
| |
| load_lib gdb-guile.exp |
| |
| standard_testfile |
| |
| proc test_value_numeric_ops {} { |
| global gdb_prompt |
| |
| gdb_scm_test_silent_cmd "gu (define i (make-value 5))" \ |
| "create first integer value" |
| gdb_scm_test_silent_cmd "gu (define j (make-value 2))" \ |
| "create second integer value" |
| gdb_test "gu (print (value-add i j))" \ |
| "= 7" "add two integer values" |
| gdb_test "gu (raw-print (value-add i j))" \ |
| "= #<gdb:value 7>" "verify type of integer add result" |
| |
| gdb_scm_test_silent_cmd "gu (define f (make-value 1.25))" \ |
| "create first double value" |
| gdb_scm_test_silent_cmd "gu (define g (make-value 2.5))" \ |
| "create second double value" |
| gdb_test "gu (print (value-add f g))" \ |
| "= 3.75" "add two double values" |
| gdb_test "gu (raw-print (value-add f g))" \ |
| "= #<gdb:value 3.75>" "verify type of double add result" |
| |
| gdb_test "gu (print (value-sub i j))" \ |
| "= 3" "subtract two integer values" |
| gdb_test "gu (print (value-sub f g))" \ |
| "= -1.25" "subtract two double values" |
| |
| gdb_test "gu (print (value-mul i j))" \ |
| "= 10" "multiply two integer values" |
| gdb_test "gu (print (value-mul f g))" \ |
| "= 3.125" "multiply two double values" |
| |
| gdb_test "gu (print (value-div i j))" \ |
| "= 2" "divide two integer values" |
| gdb_test "gu (print (value-div f g))" \ |
| "= 0.5" "divide two double values" |
| gdb_test "gu (print (value-rem i j))" \ |
| "= 1" "take remainder of two integer values" |
| gdb_test "gu (print (value-mod i j))" \ |
| "= 1" "take modulus of two integer values" |
| |
| gdb_test "gu (print (value-pow i j))" \ |
| "= 25" "integer value raised to the power of another integer value" |
| gdb_test "gu (print (value-pow g j))" \ |
| "= 6.25" "double value raised to the power of integer value" |
| |
| gdb_test "gu (print (value-neg i))" \ |
| "= -5" "negated integer value" |
| gdb_test "gu (print (value-pos i))" \ |
| "= 5" "positive integer value" |
| gdb_test "gu (print (value-neg f))" \ |
| "= -1.25" "negated double value" |
| gdb_test "gu (print (value-pos f))" \ |
| "= 1.25" "positive double value" |
| gdb_test "gu (print (value-abs (value-sub j i)))" \ |
| "= 3" "absolute of integer value" |
| gdb_test "gu (print (value-abs (value-sub f g)))" \ |
| "= 1.25" "absolute of double value" |
| |
| gdb_test "gu (print (value-lsh i j))" \ |
| "= 20" "left shift" |
| gdb_test "gu (print (value-rsh i j))" \ |
| "= 1" "right shift" |
| |
| gdb_test "gu (print (value-min i j))" \ |
| "= 2" "min" |
| gdb_test "gu (print (value-max i j))" \ |
| "= 5" "max" |
| |
| gdb_test "gu (print (value-lognot i))" \ |
| "= -6" "lognot" |
| gdb_test "gu (print (value-logand i j))" \ |
| "= 0" "logand i j" |
| gdb_test "gu (print (value-logand 5 1))" \ |
| "= 1" "logand 5 1" |
| gdb_test "gu (print (value-logior i j))" \ |
| "= 7" "logior i j" |
| gdb_test "gu (print (value-logior 5 1))" \ |
| "= 5" "logior 5 1" |
| gdb_test "gu (print (value-logxor i j))" \ |
| "= 7" "logxor i j" |
| gdb_test "gu (print (value-logxor 5 1))" \ |
| "= 4" "logxor 5 1" |
| |
| # Test <gdb:value> mixed with Guile types. |
| |
| gdb_test "gu (print (value-sub i 1))" \ |
| "= 4" "subtract integer value from guile integer" |
| gdb_test "gu (raw-print (value-sub i 1))" \ |
| "#<gdb:value 4>" \ |
| "verify type of mixed integer subtraction result" |
| gdb_test "gu (print (value-add f 1.5))" \ |
| "= 2.75" "add double value with guile float" |
| |
| gdb_test "gu (print (value-sub 1 i))" \ |
| "= -4" "subtract guile integer from integer value" |
| gdb_test "gu (print (value-add 1.5 f))" \ |
| "= 2.75" "add guile float with double value" |
| |
| # Enum conversion test. |
| gdb_test "print evalue" "= TWO" |
| gdb_test "gu (print (value->integer (history-ref 0)))" "= 2" |
| |
| # Test pointer arithmetic. |
| |
| # First, obtain the pointers. |
| gdb_test "print (void *) 2" ".*" "" |
| gdb_test_no_output "gu (define a (history-ref 0))" |
| gdb_test "print (void *) 5" ".*" "" |
| gdb_test_no_output "gu (define b (history-ref 0))" |
| |
| gdb_test "gu (print (value-add a 5))" \ |
| "= 0x7( <.*>)?" "add pointer value with guile integer" |
| gdb_test "gu (print (value-sub b 2))" \ |
| "= 0x3( <.*>)?" "subtract guile integer from pointer value" |
| gdb_test "gu (print (value-sub b a))" \ |
| "= 3" "subtract two pointer values" |
| |
| # Test some invalid operations. |
| |
| gdb_test_multiple "gu (print (value-add i '()))" "catch error in guile type conversion" { |
| -re "Wrong type argument in position 2.*$gdb_prompt $" {pass "catch error in guile type conversion"} |
| -re "= .*$gdb_prompt $" {fail "catch error in guile type conversion"} |
| -re "$gdb_prompt $" {fail "catch error in guile type conversion"} |
| } |
| |
| gdb_test_multiple "gu (print (value-add i \"foo\"))" "catch throw of GDB error" { |
| -re "Argument to arithmetic operation not a number or boolean.*$gdb_prompt $" {pass "catch throw of GDB error"} |
| -re "= .*$gdb_prompt $" {fail "catch throw of GDB error"} |
| -re "$gdb_prompt $" {fail "catch throw of GDB error"} |
| } |
| } |
| |
| # Return the max signed int of size SIZE. |
| # TCL 8.5 required here. Use lookup table instead? |
| |
| proc get_max_int { size } { |
| return [expr "(1 << ($size - 1)) - 1"] |
| } |
| |
| # Return the min signed int of size SIZE. |
| # TCL 8.5 required here. Use lookup table instead? |
| |
| proc get_min_int { size } { |
| return [expr "-(1 << ($size - 1))"] |
| } |
| |
| # Return the max unsigned int of size SIZE. |
| # TCL 8.5 required here. Use lookup table instead? |
| |
| proc get_max_uint { size } { |
| return [expr "(1 << $size) - 1"] |
| } |
| |
| # Helper routine for test_value_numeric_ranges. |
| |
| proc test_make_int_value { name size } { |
| set max [get_max_int $size] |
| set min [get_min_int $size] |
| set umax [get_max_uint $size] |
| gdb_test "gu (print (value-type (make-value $max)))" \ |
| "= $name" "test make-value $name $size max" |
| gdb_test "gu (print (value-type (make-value $min)))" \ |
| "= $name" "test make-value $name $size min" |
| gdb_test "gu (print (value-type (make-value $umax)))" \ |
| "= unsigned $name" "test make-value unsigned $name $size umax" |
| } |
| |
| # Helper routine for test_value_numeric_ranges. |
| |
| proc test_make_typed_int_value { size } { |
| set name "int$size" |
| set uname "uint$size" |
| set max [get_max_int $size] |
| set min [get_min_int $size] |
| set umax [get_max_uint $size] |
| |
| gdb_test "gu (print (make-value $max #:type (arch-${name}-type arch)))" \ |
| "= $max" "test make-value $name $size max" |
| gdb_test "gu (print (make-value $min #:type (arch-${name}-type arch)))" \ |
| "= $min" "test make-value $name $size min" |
| gdb_test "gu (print (make-value $umax #:type (arch-${uname}-type arch)))" \ |
| "= $umax" "test make-value $uname $size umax" |
| |
| gdb_test "gu (print (make-value (+ $max 1) #:type (arch-${name}-type arch)))" \ |
| "ERROR.*Out of range.*" "test make-value $name $size max+1" |
| gdb_test "gu (print (make-value (- $min 1) #:type (arch-${name}-type arch)))" \ |
| "ERROR.*Out of range.*" "test make-value $name $size min-1" |
| gdb_test "gu (print (make-value (+ $umax 1) #:type (arch-${uname}-type arch)))" \ |
| "ERROR.*Out of range.*" "test make-value $uname $size umax+1" |
| } |
| |
| proc test_value_numeric_ranges {} { |
| # We can't assume anything about sizeof (int), etc. on the target. |
| # Keep it simple for now, this will cover everything important for |
| # the major targets. |
| set int_size [get_sizeof "int" 0] |
| set long_size [get_sizeof "long" 0] |
| gdb_test_no_output "gu (define arch (current-arch))" |
| |
| if { $int_size == 4 } { |
| test_make_int_value int 32 |
| } |
| if { $long_size == 8} { |
| test_make_int_value long 64 |
| } |
| gdb_test "gu (print (value-type (make-value (ash 1 64))))" \ |
| "ERROR:.*value not a number representable.*" \ |
| "test make-value, number too large" |
| |
| foreach size { 8 16 32 } { |
| test_make_typed_int_value $size |
| } |
| if { $long_size == 8 } { |
| test_make_typed_int_value 64 |
| } |
| } |
| |
| proc test_value_boolean {} { |
| # Note: Boolean values print as 0,1 because they are printed in the |
| # current language (in this case C). |
| |
| gdb_test "gu (print (make-value #t))" "= 1" "create boolean true" |
| gdb_test "gu (print (make-value #f))" "= 0" "create boolean false" |
| |
| gdb_test "gu (print (value-not (make-value #t)))" \ |
| "= 0" "not true" |
| gdb_test "gu (print (value-not (make-value #f)))" \ |
| "= 1" "not false" |
| |
| gdb_test "gu (raw-print (make-value #t))" \ |
| "#<gdb:value 1>" "verify type of boolean" |
| } |
| |
| proc test_value_compare {} { |
| gdb_test "gu (print (value<? 1 1))" \ |
| "#f" "less than, equal" |
| gdb_test "gu (print (value<? 1 2))" \ |
| "#t" "less than, less" |
| gdb_test "gu (print (value<? 2 1))" \ |
| "#f" "less than, greater" |
| |
| gdb_test "gu (print (value<=? 1 1))" \ |
| "#t" "less or equal, equal" |
| gdb_test "gu (print (value<=? 1 2))" \ |
| "#t" "less or equal, less" |
| gdb_test "gu (print (value<=? 2 1))" \ |
| "#f" "less or equal, greater" |
| |
| gdb_test "gu (print (value=? 1 1))" \ |
| "#t" "equality" |
| gdb_test "gu (print (value=? 1 2))" \ |
| "#f" "inequality" |
| gdb_test "gu (print (value=? (make-value 1) 1.0))" \ |
| "#t" "equality of gdb:value with Guile value" |
| gdb_test "gu (print (value=? (make-value 1) 2))" \ |
| "#f" "inequality of gdb:value with Guile value" |
| |
| gdb_test "gu (print (value>? 1 1))" \ |
| "#f" "greater than, equal" |
| gdb_test "gu (print (value>? 1 2))" \ |
| "#f" "greater than, less" |
| gdb_test "gu (print (value>? 2 1))" \ |
| "#t" "greater than, greater" |
| |
| gdb_test "gu (print (value>=? 1 1))" \ |
| "#t" "greater or equal, equal" |
| gdb_test "gu (print (value>=? 1 2))" \ |
| "#f" "greater or equal, less" |
| gdb_test "gu (print (value>=? 2 1))" \ |
| "#t" "greater or equal, greater" |
| } |
| |
| if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug c}]} { |
| return |
| } |
| |
| # Skip all tests if Guile scripting is not enabled. |
| if { [skip_guile_tests] } { continue } |
| |
| if ![gdb_guile_runto_main] { |
| return |
| } |
| |
| test_value_numeric_ops |
| test_value_numeric_ranges |
| test_value_boolean |
| test_value_compare |