1# Copyright (C) 2010-2020 Free Software Foundation, Inc. 2 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 3 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16# This file is part of the GDB testsuite. 17# It tests GDB parameter support in Guile. 18 19load_lib gdb-guile.exp 20 21# Start with a fresh gdb. 22gdb_exit 23gdb_start 24gdb_reinitialize_dir $srcdir/$subdir 25 26# Skip all tests if Guile scripting is not enabled. 27if { [skip_guile_tests] } { continue } 28 29gdb_install_guile_utils 30gdb_install_guile_module 31 32# We use "." here instead of ":" so that this works on win32 too. 33set escaped_directory [string_to_regexp "$srcdir/$subdir"] 34gdb_test "guile (print (parameter-value \"directories\"))" "$escaped_directory.\\\$cdir.\\\$cwd" 35 36# Test a simple boolean parameter, and parameter? while we're at it. 37 38gdb_test_multiline "Simple gdb boolean parameter" \ 39 "guile" "" \ 40 "(define test-param" "" \ 41 " (make-parameter \"print test-param\"" "" \ 42 " #:command-class COMMAND_DATA" "" \ 43 " #:parameter-type PARAM_BOOLEAN" "" \ 44 " #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \ 45 " #:set-doc \"Set the state of the boolean test-param.\"" "" \ 46 " #:show-doc \"Show the state of the boolean test-param.\"" "" \ 47 " #:show-func (lambda (self value)" ""\ 48 " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \ 49 " #:initial-value #t))" "" \ 50 "(register-parameter! test-param)" "" \ 51 "end" 52 53with_test_prefix "test-param" { 54 gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)" 55 gdb_test "show print test-param" "The state of the Test Parameter is on." "show parameter on" 56 gdb_test_no_output "set print test-param off" 57 gdb_test "show print test-param" "The state of the Test Parameter is off." "show parameter off" 58 gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)" 59 gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help" 60 gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help" 61 gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help" 62 63 gdb_test "guile (print (parameter? test-param))" "= #t" 64 gdb_test "guile (print (parameter? 42))" "= #f" 65} 66 67# Test an enum parameter. 68 69gdb_test_multiline "enum gdb parameter" \ 70 "guile" "" \ 71 "(define test-enum-param" "" \ 72 " (make-parameter \"print test-enum-param\"" "" \ 73 " #:command-class COMMAND_DATA" "" \ 74 " #:parameter-type PARAM_ENUM" "" \ 75 " #:enum-list '(\"one\" \"two\")" "" \ 76 " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \ 77 " #:show-doc \"Show the state of the enum.\"" "" \ 78 " #:set-doc \"Set the state of the enum.\"" "" \ 79 " #:show-func (lambda (self value)" "" \ 80 " (format #f \"The state of the enum is ~a.\" value))" "" \ 81 " #:initial-value \"one\"))" "" \ 82 "(register-parameter! test-enum-param)" "" \ 83 "end" 84 85with_test_prefix "test-enum-param" { 86 gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)" 87 gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value" 88 gdb_test_no_output "set print test-enum-param two" 89 gdb_test "show print test-enum-param" "The state of the enum is two." "show new value" 90 gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)" 91 gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter" 92} 93 94# Test a file parameter. 95 96gdb_test_multiline "file gdb parameter" \ 97 "guile" "" \ 98 "(define test-file-param" "" \ 99 " (make-parameter \"test-file-param\"" "" \ 100 " #:command-class COMMAND_FILES" "" \ 101 " #:parameter-type PARAM_FILENAME" "" \ 102 " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \ 103 " #:show-doc \"Show the name of the file.\"" "" \ 104 " #:set-doc \"Set the name of the file.\"" "" \ 105 " #:show-func (lambda (self value)" "" \ 106 " (format #f \"The name of the file is ~a.\" value))" "" \ 107 " #:initial-value \"foo.txt\"))" "" \ 108 "(register-parameter! test-file-param)" "" \ 109 "end" 110 111with_test_prefix "test-file-param" { 112 gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value" 113 gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value" 114 gdb_test_no_output "set test-file-param bar.txt" 115 gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value" 116 gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value" 117 gdb_test "set test-file-param" "Argument required.*" 118} 119 120# Test a parameter that is not documented. 121 122gdb_test_multiline "undocumented gdb parameter" \ 123 "guile" "" \ 124 "(register-parameter! (make-parameter \"print test-undoc-param\"" "" \ 125 " #:command-class COMMAND_DATA" "" \ 126 " #:parameter-type PARAM_BOOLEAN" "" \ 127 " #:show-func (lambda (self value)" "" \ 128 " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \ 129 " #:initial-value #t))" "" \ 130 "end" 131 132with_test_prefix "test-undocumented-param" { 133 gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on" 134 gdb_test_no_output "set print test-undoc-param off" 135 gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off" 136 gdb_test "help show print test-undoc-param" "This command is not documented." "show help" 137 gdb_test "help set print test-undoc-param" "This command is not documented." "set help" 138 gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help" 139} 140 141# Test a parameter with a restricted range, where we need to notify the user 142# and restore the previous value. 143 144gdb_test_multiline "restricted gdb parameter" \ 145 "guile" "" \ 146 "(register-parameter! (make-parameter \"test-restricted-param\"" "" \ 147 " #:command-class COMMAND_DATA" "" \ 148 " #:parameter-type PARAM_ZINTEGER" "" \ 149 " #:set-func (lambda (self)" "" \ 150 " (let ((value (parameter-value self)))" "" \ 151 " (if (and (>= value 0) (<= value 10))" "" \ 152 " \"\"" "" \ 153 " (begin" "" \ 154 " (set-parameter-value! self (object-property self 'value))" "" \ 155 " \"Error: Range of parameter is 0-10.\"))))" "" \ 156 " #:show-func (lambda (self value)" "" \ 157 " (format #f \"The value of the restricted parameter is ~a.\" value))" "" \ 158 " #:initial-value (lambda (self)" "" \ 159 " (set-object-property! self 'value 2)" "" \ 160 " 2)))" "" \ 161 "end" 162 163with_test_prefix "test-restricted-param" { 164 gdb_test "show test-restricted-param" "The value of the restricted parameter is 2." 165 gdb_test_no_output "set test-restricted-param 10" 166 gdb_test "show test-restricted-param" "The value of the restricted parameter is 10." 167 gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10." 168 gdb_test "show test-restricted-param" "The value of the restricted parameter is 2." 169} 170 171# Test registering a parameter that already exists. 172 173gdb_test "guile (register-parameter! (make-parameter \"height\"))" \ 174 "ERROR.*is already defined.*" "error registering existing parameter" 175 176# Test registering a parameter named with what was an ambiguous spelling 177# of existing parameters. 178 179gdb_test_multiline "previously ambiguously named boolean parameter" \ 180 "guile" "" \ 181 "(define prev-ambig" "" \ 182 " (make-parameter \"print s\"" "" \ 183 " #:parameter-type PARAM_BOOLEAN))" "" \ 184 "end" 185 186gdb_test_no_output "guile (register-parameter! prev-ambig)" 187 188with_test_prefix "previously-ambiguous" { 189 gdb_test "guile (print (parameter-value prev-ambig))" "= #f" "parameter value (false)" 190 gdb_test "show print s" "Command is not documented is off." "show parameter off" 191 gdb_test_no_output "set print s on" 192 gdb_test "show print s" "Command is not documented is on." "show parameter on" 193 gdb_test "guile (print (parameter-value prev-ambig))" "= #t" "parameter value (true)" 194 gdb_test "help show print s" "This command is not documented." "show help" 195 gdb_test "help set print s" "This command is not documented." "set help" 196 gdb_test "help set print" "set print s -- This command is not documented.*" "general help" 197} 198