gdb/testsuite/gdb.guile/scm-math.exp - binutils-gdb - Git at Google

 # Copyright (C) 2008-2021 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
	# Copyright (C) 2008-2021 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