| # Copyright (C) 2010-2014 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 parameter support in Guile. |
| |
| load_lib gdb-guile.exp |
| |
| # Start with a fresh gdb. |
| gdb_exit |
| gdb_start |
| gdb_reinitialize_dir $srcdir/$subdir |
| |
| # Skip all tests if Guile scripting is not enabled. |
| if { [skip_guile_tests] } { continue } |
| |
| gdb_install_guile_utils |
| gdb_install_guile_module |
| |
| # We use "." here instead of ":" so that this works on win32 too. |
| gdb_test "guile (print (parameter-value \"directories\"))" "$srcdir/$subdir.\\\$cdir.\\\$cwd" |
| |
| # Test a simple boolean parameter, and parameter? while we're at it. |
| |
| gdb_test_multiline "Simple gdb boolean parameter" \ |
| "guile" "" \ |
| "(define test-param" "" \ |
| " (make-parameter \"print test-param\"" "" \ |
| " #:command-class COMMAND_DATA" "" \ |
| " #:parameter-type PARAM_BOOLEAN" "" \ |
| " #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \ |
| " #:set-doc \"Set the state of the boolean test-param.\"" "" \ |
| " #:show-doc \"Show the state of the boolean test-param.\"" "" \ |
| " #:show-func (lambda (self value)" ""\ |
| " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \ |
| " #:initial-value #t))" "" \ |
| "(register-parameter! test-param)" "" \ |
| "end" |
| |
| with_test_prefix "test-param" { |
| gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)" |
| gdb_test "show print test-param" "The state of the Test Parameter is on." "Show parameter on" |
| gdb_test_no_output "set print test-param off" |
| gdb_test "show print test-param" "The state of the Test Parameter is off." "Show parameter off" |
| gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)" |
| gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help" |
| gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help" |
| gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help" |
| |
| gdb_test "guile (print (parameter? test-param))" "= #t" |
| gdb_test "guile (print (parameter? 42))" "= #f" |
| } |
| |
| # Test an enum parameter. |
| |
| gdb_test_multiline "enum gdb parameter" \ |
| "guile" "" \ |
| "(define test-enum-param" "" \ |
| " (make-parameter \"print test-enum-param\"" "" \ |
| " #:command-class COMMAND_DATA" "" \ |
| " #:parameter-type PARAM_ENUM" "" \ |
| " #:enum-list '(\"one\" \"two\")" "" \ |
| " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \ |
| " #:show-doc \"Show the state of the enum.\"" "" \ |
| " #:set-doc \"Set the state of the enum.\"" "" \ |
| " #:show-func (lambda (self value)" "" \ |
| " (format #f \"The state of the enum is ~a.\" value))" "" \ |
| " #:initial-value \"one\"))" "" \ |
| "(register-parameter! test-enum-param)" "" \ |
| "end" |
| |
| with_test_prefix "test-enum-param" { |
| gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)" |
| gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value" |
| gdb_test_no_output "set print test-enum-param two" |
| gdb_test "show print test-enum-param" "The state of the enum is two." "show new value" |
| gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)" |
| gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter" |
| } |
| |
| # Test a file parameter. |
| |
| gdb_test_multiline "file gdb parameter" \ |
| "guile" "" \ |
| "(define test-file-param" "" \ |
| " (make-parameter \"test-file-param\"" "" \ |
| " #:command-class COMMAND_FILES" "" \ |
| " #:parameter-type PARAM_FILENAME" "" \ |
| " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \ |
| " #:show-doc \"Show the name of the file.\"" "" \ |
| " #:set-doc \"Set the name of the file.\"" "" \ |
| " #:show-func (lambda (self value)" "" \ |
| " (format #f \"The name of the file is ~a.\" value))" "" \ |
| " #:initial-value \"foo.txt\"))" "" \ |
| "(register-parameter! test-file-param)" "" \ |
| "end" |
| |
| with_test_prefix "test-file-param" { |
| gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value" |
| gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value" |
| gdb_test_no_output "set test-file-param bar.txt" |
| gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value" |
| gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value" |
| gdb_test "set test-file-param" "Argument required.*" |
| } |
| |
| # Test a parameter that is not documented. |
| |
| gdb_test_multiline "undocumented gdb parameter" \ |
| "guile" "" \ |
| "(register-parameter! (make-parameter \"print test-undoc-param\"" "" \ |
| " #:command-class COMMAND_DATA" "" \ |
| " #:parameter-type PARAM_BOOLEAN" "" \ |
| " #:show-func (lambda (self value)" "" \ |
| " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \ |
| " #:initial-value #t))" "" \ |
| "end" |
| |
| with_test_prefix "test-undocumented-param" { |
| gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on" |
| gdb_test_no_output "set print test-undoc-param off" |
| gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off" |
| gdb_test "help show print test-undoc-param" "This command is not documented." "show help" |
| gdb_test "help set print test-undoc-param" "This command is not documented." "set help" |
| gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help" |
| } |
| |
| # Test a parameter with a restricted range, where we need to notify the user |
| # and restore the previous value. |
| |
| gdb_test_multiline "restricted gdb parameter" \ |
| "guile" "" \ |
| "(register-parameter! (make-parameter \"test-restricted-param\"" "" \ |
| " #:command-class COMMAND_DATA" "" \ |
| " #:parameter-type PARAM_ZINTEGER" "" \ |
| " #:set-func (lambda (self)" "" \ |
| " (let ((value (parameter-value self)))" "" \ |
| " (if (and (>= value 0) (<= value 10))" "" \ |
| " \"\"" "" \ |
| " (begin" "" \ |
| " (set-parameter-value! self (object-property self 'value))" "" \ |
| " \"Error: Range of parameter is 0-10.\"))))" "" \ |
| " #:show-func (lambda (self value)" "" \ |
| " (format #f \"The value of the restricted parameter is ~a.\" value))" "" \ |
| " #:initial-value (lambda (self)" "" \ |
| " (set-object-property! self 'value 2)" "" \ |
| " 2)))" "" \ |
| "end" |
| |
| with_test_prefix "test-restricted-param" { |
| gdb_test "show test-restricted-param" "The value of the restricted parameter is 2." |
| gdb_test_no_output "set test-restricted-param 10" |
| gdb_test "show test-restricted-param" "The value of the restricted parameter is 10." |
| gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10." |
| gdb_test "show test-restricted-param" "The value of the restricted parameter is 2." |
| } |
| |
| # Test registering a parameter that already exists. |
| |
| gdb_test "guile (register-parameter! (make-parameter \"height\"))" \ |
| "ERROR.*is already defined.*" "error registering existing parameter" |
| |
| # Test registering a parameter named with what was an ambiguous spelling |
| # of existing parameters. |
| |
| gdb_test_multiline "previously ambiguously named boolean parameter" \ |
| "guile" "" \ |
| "(define prev-ambig" "" \ |
| " (make-parameter \"print s\"" "" \ |
| " #:parameter-type PARAM_BOOLEAN))" "" \ |
| "end" |
| |
| gdb_test_no_output "guile (register-parameter! prev-ambig)" |
| |
| with_test_prefix "previously-ambiguous" { |
| gdb_test "guile (print (parameter-value prev-ambig))" "= #f" "parameter value (false)" |
| gdb_test "show print s" "Command is not documented is off." "Show parameter off" |
| gdb_test_no_output "set print s on" |
| gdb_test "show print s" "Command is not documented is on." "Show parameter on" |
| gdb_test "guile (print (parameter-value prev-ambig))" "= #t" "parameter value (true)" |
| gdb_test "help show print s" "This command is not documented." "show help" |
| 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" |
| } |