public inbox for gdb-cvs@sourceware.org
help / color / mirror / Atom feed
* [binutils-gdb] GDB/Guile: Don't assert that an integer value is boolean
@ 2022-10-21  7:56 Maciej W. Rozycki
  0 siblings, 0 replies; only message in thread
From: Maciej W. Rozycki @ 2022-10-21  7:56 UTC (permalink / raw)
  To: gdb-cvs

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=90319cefe398bb6c5130b48d1c0e4df5e65eb194

commit 90319cefe398bb6c5130b48d1c0e4df5e65eb194
Author: Maciej W. Rozycki <macro@embecosm.com>
Date:   Fri Oct 21 08:54:18 2022 +0100

    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>

Diff:
---
 gdb/guile/scm-param.c                     |   2 +-
 gdb/testsuite/gdb.guile/scm-parameter.exp | 176 ++++++++++++++++++++++++++++++
 2 files changed, 177 insertions(+), 1 deletion(-)

diff --git a/gdb/guile/scm-param.c b/gdb/guile/scm-param.c
index 54c8c27301a..c4e90412567 100644
--- a/gdb/guile/scm-param.c
+++ b/gdb/guile/scm-param.c
@@ -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"));
diff --git a/gdb/testsuite/gdb.guile/scm-parameter.exp b/gdb/testsuite/gdb.guile/scm-parameter.exp
index cf6f2834373..b9f2d825211 100644
--- a/gdb/testsuite/gdb.guile/scm-parameter.exp
+++ b/gdb/testsuite/gdb.guile/scm-parameter.exp
@@ -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 ""

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-10-21  7:56 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-21  7:56 [binutils-gdb] GDB/Guile: Don't assert that an integer value is boolean Maciej W. Rozycki

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).