mirror of
https://github.com/espressif/binutils-gdb.git
synced 2025-06-01 20:12:01 +08:00
GDB/Guile: Don't assert that an integer value is boolean
Do not assert that a value intended for an integer parameter, of either the PARAM_UINTEGER or the PARAM_ZUINTEGER_UNLIMITED type, is boolean, causing error messages such as: ERROR: In procedure make-parameter: ERROR: In procedure gdbscm_make_parameter: Wrong type argument in position 15 (expecting integer or #:unlimited): 3 Error while executing Scheme code. when initialization with a number is attempted. Instead assert that it is integer. Keep matching `#:unlimited' keyword as an alternative. Add suitable test cases. Approved-By: Simon Marchi <simon.marchi@polymtl.ca>
This commit is contained in:
Maciej W. Rozycki
@ -742,7 +742,7 @@ pascm_set_param_value_x (param_smob *p_smob,
|
||||
if (var.type () == var_uinteger
|
||||
|| var.type () == var_zuinteger_unlimited)
|
||||
{
|
||||
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|
||||
SCM_ASSERT_TYPE (scm_is_integer (value)
|
||||
|| scm_is_eq (value, unlimited_keyword),
|
||||
value, arg_pos, func_name,
|
||||
_("integer or #:unlimited"));
|
||||
|
||||
@ -29,6 +29,14 @@ if { [skip_guile_tests] } { continue }
|
||||
gdb_install_guile_utils
|
||||
gdb_install_guile_module
|
||||
|
||||
proc scm_param_test_maybe_no_output { command pattern args } {
|
||||
if [string length $pattern] {
|
||||
gdb_test $command $pattern $args
|
||||
} else {
|
||||
gdb_test_no_output $command $args
|
||||
}
|
||||
}
|
||||
|
||||
# We use "." here instead of ":" so that this works on win32 too.
|
||||
set escaped_directory [string_to_regexp "$srcdir/$subdir"]
|
||||
gdb_test "guile (print (parameter-value \"directories\"))" "$escaped_directory.\\\$cdir.\\\$cwd"
|
||||
@ -91,6 +99,172 @@ with_test_prefix "test-enum-param" {
|
||||
gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter"
|
||||
}
|
||||
|
||||
# Test integer parameters.
|
||||
|
||||
foreach_with_prefix param {
|
||||
"listsize"
|
||||
"print elements"
|
||||
"max-completions"
|
||||
} {
|
||||
set param_range_error "integer -1 out of range"
|
||||
set param_type_error \
|
||||
"#<gdb:exception out-of-range\
|
||||
\\(\"gdbscm_parameter_value\"\
|
||||
\"Out of range: program error: unhandled type in position 1: ~S\"\
|
||||
\\(3\\) \\(3\\)\\)>"
|
||||
switch -- $param {
|
||||
"listsize" {
|
||||
set param_get_one $param_type_error
|
||||
set param_get_zero $param_type_error
|
||||
set param_get_minus_one $param_type_error
|
||||
set param_get_unlimited $param_type_error
|
||||
set param_set_minus_one ""
|
||||
}
|
||||
"print elements" {
|
||||
set param_get_one 1
|
||||
set param_get_zero "#:unlimited"
|
||||
set param_get_minus_one "#:unlimited"
|
||||
set param_get_unlimited "#:unlimited"
|
||||
set param_set_minus_one $param_range_error
|
||||
}
|
||||
"max-completions" {
|
||||
set param_get_one 1
|
||||
set param_get_zero 0
|
||||
set param_get_minus_one "#:unlimited"
|
||||
set param_get_unlimited "#:unlimited"
|
||||
set param_set_minus_one ""
|
||||
}
|
||||
default {
|
||||
error "invalid param: $param"
|
||||
}
|
||||
}
|
||||
|
||||
gdb_test_no_output "set $param 1" "test set to 1"
|
||||
|
||||
gdb_test "guile (print (parameter-value \"$param\"))" \
|
||||
$param_get_one "test value of 1"
|
||||
|
||||
gdb_test_no_output "set $param 0" "test set to 0"
|
||||
|
||||
gdb_test "guile (print (parameter-value \"$param\"))" \
|
||||
$param_get_zero "test value of 0"
|
||||
|
||||
scm_param_test_maybe_no_output "set $param -1" \
|
||||
$param_set_minus_one "test set to -1"
|
||||
|
||||
gdb_test "guile (print (parameter-value \"$param\"))" \
|
||||
$param_get_minus_one "test value of -1"
|
||||
|
||||
gdb_test_no_output "set $param unlimited" "test set to 'unlimited'"
|
||||
|
||||
gdb_test "guile (print (parameter-value \"$param\"))" \
|
||||
$param_get_unlimited "test value of 'unlimited'"
|
||||
}
|
||||
|
||||
foreach_with_prefix kind {
|
||||
PARAM_UINTEGER
|
||||
PARAM_ZINTEGER
|
||||
PARAM_ZUINTEGER
|
||||
PARAM_ZUINTEGER_UNLIMITED
|
||||
} {
|
||||
gdb_test_multiline "create gdb parameter" \
|
||||
"guile" "" \
|
||||
"(define test-$kind-param" "" \
|
||||
" (make-parameter \"print test-$kind-param\"" "" \
|
||||
" #:command-class COMMAND_DATA" "" \
|
||||
" #:parameter-type $kind" "" \
|
||||
" #:doc \"Set to a number or 'unlimited' to yield an effect.\"" "" \
|
||||
" #:show-doc \"Show the state of $kind.\"" "" \
|
||||
" #:set-doc \"Set the state of $kind.\"" "" \
|
||||
" #:show-func (lambda (self value)" "" \
|
||||
" (format #f \"The state of $kind is ~a.\" value))" "" \
|
||||
" #:initial-value 3))" "" \
|
||||
"(register-parameter! test-$kind-param)" "" \
|
||||
"end"
|
||||
|
||||
set param_integer_error \
|
||||
"ERROR: In procedure set-parameter-value!:\r\nERROR: In procedure\
|
||||
gdbscm_set_parameter_value_x: Wrong type argument in position 2\
|
||||
\\(expecting integer\\): #:unlimited\r\nError while executing Scheme\
|
||||
code\\."
|
||||
set param_minus_one_error "integer -1 out of range"
|
||||
set param_minus_two_range "integer -2 out of range"
|
||||
set param_minus_two_unlimited "only -1 is allowed to set as unlimited"
|
||||
switch -- $kind {
|
||||
PARAM_UINTEGER {
|
||||
set param_get_zero "#:unlimited"
|
||||
set param_get_minus_one "#:unlimited"
|
||||
set param_get_minus_two "#:unlimited"
|
||||
set param_str_unlimited unlimited
|
||||
set param_set_unlimited ""
|
||||
set param_set_minus_one $param_minus_one_error
|
||||
set param_set_minus_two $param_minus_two_range
|
||||
}
|
||||
PARAM_ZINTEGER {
|
||||
set param_get_zero 0
|
||||
set param_get_minus_one -1
|
||||
set param_get_minus_two -2
|
||||
set param_str_unlimited 2
|
||||
set param_set_unlimited $param_integer_error
|
||||
set param_set_minus_one ""
|
||||
set param_set_minus_two ""
|
||||
}
|
||||
PARAM_ZUINTEGER {
|
||||
set param_get_zero 0
|
||||
set param_get_minus_one 0
|
||||
set param_get_minus_two 0
|
||||
set param_str_unlimited 2
|
||||
set param_set_unlimited $param_integer_error
|
||||
set param_set_minus_one $param_minus_one_error
|
||||
set param_set_minus_two $param_minus_two_range
|
||||
}
|
||||
PARAM_ZUINTEGER_UNLIMITED {
|
||||
set param_get_zero 0
|
||||
set param_get_minus_one "#:unlimited"
|
||||
set param_get_minus_two "#:unlimited"
|
||||
set param_str_unlimited unlimited
|
||||
set param_set_unlimited ""
|
||||
set param_set_minus_one ""
|
||||
set param_set_minus_two $param_minus_two_unlimited
|
||||
}
|
||||
default {
|
||||
error "invalid kind: $kind"
|
||||
}
|
||||
}
|
||||
|
||||
with_test_prefix "test-$kind-param" {
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
3 "$kind parameter value (3)"
|
||||
gdb_test "show print test-$kind-param" \
|
||||
"The state of $kind is 3." "show initial value"
|
||||
gdb_test_no_output "set print test-$kind-param 2"
|
||||
gdb_test "show print test-$kind-param" \
|
||||
"The state of $kind is 2." "show new value"
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
2 "$kind parameter value (2)"
|
||||
scm_param_test_maybe_no_output \
|
||||
"guile (set-parameter-value! test-$kind-param #:unlimited)" \
|
||||
$param_set_unlimited
|
||||
gdb_test "show print test-$kind-param" \
|
||||
"The state of $kind is $param_str_unlimited." \
|
||||
"show unlimited value"
|
||||
gdb_test_no_output "guile (set-parameter-value! test-$kind-param 1)"
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
1 "$kind parameter value (1)"
|
||||
gdb_test_no_output "guile (set-parameter-value! test-$kind-param 0)"
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
$param_get_zero "$kind parameter value (0)"
|
||||
scm_param_test_maybe_no_output "set print test-$kind-param -1" \
|
||||
$param_set_minus_one
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
$param_get_minus_one "$kind parameter value (-1)"
|
||||
scm_param_test_maybe_no_output "set print test-$kind-param -2" \
|
||||
$param_set_minus_two
|
||||
gdb_test "guile (print (parameter-value test-$kind-param))" \
|
||||
$param_get_minus_two "$kind parameter value (-2)"
|
||||
}
|
||||
}
|
||||
|
||||
# Test a file parameter.
|
||||
|
||||
gdb_test_multiline "file gdb parameter" \
|
||||
@ -206,3 +380,5 @@ with_test_prefix "previously-ambiguous" {
|
||||
gdb_test "help set print s" "This command is not documented." "set help"
|
||||
gdb_test "help set print" "set print s -- This command is not documented.*" "general help"
|
||||
}
|
||||
|
||||
rename scm_param_test_maybe_no_output ""
|
||||
|
||||
Reference in New Issue
Block a user