mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2024-12-15 04:31:49 +08:00
4a94e36819
This commit brings all the changes made by running gdb/copyright.py as per GDB's Start of New Year Procedure. For the avoidance of doubt, all changes in this commits were performed by the script.
350 lines
12 KiB
Plaintext
350 lines
12 KiB
Plaintext
# Copyright (C) 2008-2022 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 pointer creation.
|
|
|
|
gdb_test_no_output "gu (define void-pointer-type (type-pointer (arch-void-type (current-arch))))"
|
|
gdb_scm_test_silent_cmd "gu (define null-pointer (make-value 0 #:type void-pointer-type))" \
|
|
"test make-value with pointer type"
|
|
gdb_test "gu (print null-pointer)" "= 0x0"
|
|
gdb_test "gu (print (equal? (value-type null-pointer) void-pointer-type))" \
|
|
"= #t"
|
|
|
|
# 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
|
|
}
|
|
}
|
|
|
|
# Helper routine for test_pointer_numeric_range.
|
|
|
|
proc test_make_pointer_value { size } {
|
|
set max [get_max_uint $size]
|
|
set max_hex [string repeat "f" [expr "$size / 4"]]
|
|
|
|
gdb_test "gu (print (make-value $max #:type void-pointer-type))" \
|
|
"= 0x$max_hex" "test make-value void* max"
|
|
gdb_test "gu (print (make-value 0 #:type void-pointer-type))" \
|
|
"= 0x0" "test make-value void* 0"
|
|
|
|
gdb_test "gu (print (make-value (+ $max 1) #:type void-pointer-type))" \
|
|
"ERROR.*Out of range.*" "test make-value void* max+1"
|
|
gdb_test "gu (print (make-value -1 #:type void-pointer-type))" \
|
|
"ERROR.*Out of range.*" "test make-value void* -1"
|
|
}
|
|
|
|
proc test_pointer_numeric_range {} {
|
|
# We can't assume anything about sizeof (void*) on the target.
|
|
# Keep it simple for now, this will cover everything important for
|
|
# the major targets.
|
|
set pointer_size [get_sizeof "void*" 0]
|
|
if { $pointer_size == 4 } {
|
|
test_make_pointer_value 32
|
|
}
|
|
if { $pointer_size == 8 } {
|
|
test_make_pointer_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 "failed to prepare" $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_pointer_numeric_range
|
|
test_value_boolean
|
|
test_value_compare
|