From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-lf1-x12d.google.com (mail-lf1-x12d.google.com [IPv6:2a00:1450:4864:20::12d]) by sourceware.org (Postfix) with ESMTPS id 9AB513858C33 for ; Wed, 17 Aug 2022 22:03:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 9AB513858C33 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=embecosm.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=embecosm.com Received: by mail-lf1-x12d.google.com with SMTP id x19so20700078lfq.7 for ; Wed, 17 Aug 2022 15:03:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=mime-version:user-agent:references:message-id:in-reply-to:subject :cc:to:from:date:from:to:cc; bh=rut5Xw9Xqho0Am/DqzX7QKM9WMSfL1l24IyO+Jh51cA=; b=aYUipEYfDV1hwi+hunoQOHyOdzDHMy8nvV4DnBni7qe367Xs412iYKvTwL16e1dI04 MI5kHQTw/kPuRJ3F+7q8+Pi4Mpt60Fxlghrxzqb5iiwdidmqIVXXT5HCKQgZKvRiIrzM 5EELZYP3KeX5vhKU+Q1bqIfyDXPe34wzg4ARShqc5+27mS2oitPQMNFCFp/Mlj/cOr+k m0y+XDOBHbJIb6H87oGWrAquWb46gsT79moiBn7BLj62+22MdxfFuCnZkNhcfZmjsUb+ S+5Fi+N8YhmIXK6XNhYZeqL0kwd3SMKktOJrX2+gR+oWps0bK4OfAsZVDK/r7IrhHAoq ODRg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:user-agent:references:message-id:in-reply-to:subject :cc:to:from:date:x-gm-message-state:from:to:cc; bh=rut5Xw9Xqho0Am/DqzX7QKM9WMSfL1l24IyO+Jh51cA=; b=FWpM43rXva38mbMf6Xq3F0s0/GzPRUegFcCGGQxHj3JCAcekH/4jM/ZhRQ5z7kx3gy 4MhN1FxTqwAZkaRUwCG5InehPmajqttnbUZ8FSRfinirE/ECEtKW0YnC5shJtnlwvSen JwMNdEzZgV9emr5H9FrqAEpLan880GCzJMDXVuzwDOzY5NL2HUnvQDWbNabRXMRV3wbi g+Vgc+ESw7sE6K07uHNS+ccN+sDc5QleYXBqf75VJVBXhMRxJWoFbqR1B5LWlQsd4Jfu pAR06+nvjiDFOb7xPBlq1o/7WBkPJpFRGOp1E36m0ZKZhdl0PQvgD/ETwtOqWbmrhk1M 56xA== X-Gm-Message-State: ACgBeo1q7RFc5uFBPZSlNpif7E+75cBqZ5ANFE0Vgus2c8pqbM+6ZE6V 2csyQ/MI2YTbkNIPLqGkhZoX+dKztZfycazP X-Google-Smtp-Source: AA6agR7ldkRZ4aqdU/y6kUiSVTXnNMD/3kW1n241zmiLYZI7P/+srL60j+97EbS4RxrfC7C/Pag8tA== X-Received: by 2002:a05:6512:695:b0:491:6ee3:bf33 with SMTP id t21-20020a056512069500b004916ee3bf33mr64208lfe.276.1660773825149; Wed, 17 Aug 2022 15:03:45 -0700 (PDT) Received: from [192.168.219.3] ([78.8.192.131]) by smtp.gmail.com with ESMTPSA id c24-20020a196558000000b0048a83336343sm1827340lfj.252.2022.08.17.15.03.43 (version=TLS1_2 cipher=ECDHE-ECDSA-AES128-GCM-SHA256 bits=128/128); Wed, 17 Aug 2022 15:03:44 -0700 (PDT) Date: Wed, 17 Aug 2022 23:03:42 +0100 (BST) From: "Maciej W. Rozycki" To: gdb-patches@sourceware.org cc: Andrew Burgess , Simon Marchi , Tom Tromey , Simon Sobisch Subject: [PATCH v6 1/8] GDB/Guile: Don't assert that an integer value is boolean In-Reply-To: Message-ID: References: User-Agent: Alpine 2.20 (DEB 67 2015-01-07) MIME-Version: 1.0 Content-Type: text/plain; charset=US-ASCII X-Spam-Status: No, score=-2.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=no autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 17 Aug 2022 22:03:49 -0000 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. --- Hi, Probably obvious, and shows how much use this code gets. Maciej New change in v6. --- gdb/guile/scm-param.c | 2 gdb/testsuite/gdb.guile/scm-parameter.exp | 176 ++++++++++++++++++++++++++++++ 2 files changed, 177 insertions(+), 1 deletion(-) gdb-guile-scm-param-is-integer.diff Index: src/gdb/guile/scm-param.c =================================================================== --- src.orig/gdb/guile/scm-param.c +++ src/gdb/guile/scm-param.c @@ -742,7 +742,7 @@ pascm_set_param_value_x (param_smob *p_s 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")); Index: src/gdb/testsuite/gdb.guile/scm-parameter.exp =================================================================== --- src.orig/gdb/testsuite/gdb.guile/scm-parameter.exp +++ src/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 \ + "#" + 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 ""