1 # Copyright (C) 2010-2014 Free Software Foundation, Inc.
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.
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.
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/>.
16 # This file is part of the GDB testsuite.
17 # It tests GDB parameter support in Guile.
19 load_lib gdb-guile.exp
21 # Start with a fresh gdb.
24 gdb_reinitialize_dir $srcdir/$subdir
26 # Skip all tests if Guile scripting is not enabled.
27 if { [skip_guile_tests] } { continue }
29 gdb_install_guile_utils
30 gdb_install_guile_module
32 # We use "." here instead of ":" so that this works on win32 too.
33 gdb_test "guile (print (parameter-value \"directories\"))" "$srcdir/$subdir.\\\$cdir.\\\$cwd"
35 # Test a simple boolean parameter, and parameter? while we're at it.
37 gdb_test_multiline "Simple gdb boolean parameter" \
39 "(define test-param" "" \
40 " (make-parameter \"print test-param\"" "" \
41 " #:command-class COMMAND_DATA" "" \
42 " #:parameter-type PARAM_BOOLEAN" "" \
43 " #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \
44 " #:set-doc \"Set the state of the boolean test-param.\"" "" \
45 " #:show-doc \"Show the state of the boolean test-param.\"" "" \
46 " #:show-func (lambda (self value)" ""\
47 " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
48 " #:initial-value #t))" "" \
49 "(register-parameter! test-param)" "" \
52 with_test_prefix "test-param" {
53 gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)"
54 gdb_test "show print test-param" "The state of the Test Parameter is on." "Show parameter on"
55 gdb_test_no_output "set print test-param off"
56 gdb_test "show print test-param" "The state of the Test Parameter is off." "Show parameter off"
57 gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)"
58 gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help"
59 gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help"
60 gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help"
62 gdb_test "guile (print (parameter? test-param))" "= #t"
63 gdb_test "guile (print (parameter? 42))" "= #f"
66 # Test an enum parameter.
68 gdb_test_multiline "enum gdb parameter" \
70 "(define test-enum-param" "" \
71 " (make-parameter \"print test-enum-param\"" "" \
72 " #:command-class COMMAND_DATA" "" \
73 " #:parameter-type PARAM_ENUM" "" \
74 " #:enum-list '(\"one\" \"two\")" "" \
75 " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
76 " #:show-doc \"Show the state of the enum.\"" "" \
77 " #:set-doc \"Set the state of the enum.\"" "" \
78 " #:show-func (lambda (self value)" "" \
79 " (format #f \"The state of the enum is ~a.\" value))" "" \
80 " #:initial-value \"one\"))" "" \
81 "(register-parameter! test-enum-param)" "" \
84 with_test_prefix "test-enum-param" {
85 gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)"
86 gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value"
87 gdb_test_no_output "set print test-enum-param two"
88 gdb_test "show print test-enum-param" "The state of the enum is two." "show new value"
89 gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)"
90 gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter"
93 # Test a file parameter.
95 gdb_test_multiline "file gdb parameter" \
97 "(define test-file-param" "" \
98 " (make-parameter \"test-file-param\"" "" \
99 " #:command-class COMMAND_FILES" "" \
100 " #:parameter-type PARAM_FILENAME" "" \
101 " #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
102 " #:show-doc \"Show the name of the file.\"" "" \
103 " #:set-doc \"Set the name of the file.\"" "" \
104 " #:show-func (lambda (self value)" "" \
105 " (format #f \"The name of the file is ~a.\" value))" "" \
106 " #:initial-value \"foo.txt\"))" "" \
107 "(register-parameter! test-file-param)" "" \
110 with_test_prefix "test-file-param" {
111 gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value"
112 gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value"
113 gdb_test_no_output "set test-file-param bar.txt"
114 gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value"
115 gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value"
116 gdb_test "set test-file-param" "Argument required.*"
119 # Test a parameter that is not documented.
121 gdb_test_multiline "undocumented gdb parameter" \
123 "(register-parameter! (make-parameter \"print test-undoc-param\"" "" \
124 " #:command-class COMMAND_DATA" "" \
125 " #:parameter-type PARAM_BOOLEAN" "" \
126 " #:show-func (lambda (self value)" "" \
127 " (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
128 " #:initial-value #t))" "" \
131 with_test_prefix "test-undocumented-param" {
132 gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on"
133 gdb_test_no_output "set print test-undoc-param off"
134 gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off"
135 gdb_test "help show print test-undoc-param" "This command is not documented." "show help"
136 gdb_test "help set print test-undoc-param" "This command is not documented." "set help"
137 gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help"
140 # Test a parameter with a restricted range, where we need to notify the user
141 # and restore the previous value.
143 gdb_test_multiline "restricted gdb parameter" \
145 "(register-parameter! (make-parameter \"test-restricted-param\"" "" \
146 " #:command-class COMMAND_DATA" "" \
147 " #:parameter-type PARAM_ZINTEGER" "" \
148 " #:set-func (lambda (self)" "" \
149 " (let ((value (parameter-value self)))" "" \
150 " (if (and (>= value 0) (<= value 10))" "" \
153 " (set-parameter-value! self (object-property self 'value))" "" \
154 " \"Error: Range of parameter is 0-10.\"))))" "" \
155 " #:show-func (lambda (self value)" "" \
156 " (format #f \"The value of the restricted parameter is ~a.\" value))" "" \
157 " #:initial-value (lambda (self)" "" \
158 " (set-object-property! self 'value 2)" "" \
162 with_test_prefix "test-restricted-param" {
163 gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
164 gdb_test_no_output "set test-restricted-param 10"
165 gdb_test "show test-restricted-param" "The value of the restricted parameter is 10."
166 gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10."
167 gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
170 # Test registering a parameter that already exists.
172 gdb_test "guile (register-parameter! (make-parameter \"height\"))" \
173 "ERROR.*is already defined.*" "error registering existing parameter"
175 # Test registering a parameter named with what was an ambiguous spelling
176 # of existing parameters.
178 gdb_test_multiline "previously ambiguously named boolean parameter" \
180 "(define prev-ambig" "" \
181 " (make-parameter \"print s\"" "" \
182 " #:parameter-type PARAM_BOOLEAN))" "" \
185 gdb_test_no_output "guile (register-parameter! prev-ambig)"
187 with_test_prefix "previously-ambiguous" {
188 gdb_test "guile (print (parameter-value prev-ambig))" "= #f" "parameter value (false)"
189 gdb_test "show print s" "Command is not documented is off." "Show parameter off"
190 gdb_test_no_output "set print s on"
191 gdb_test "show print s" "Command is not documented is on." "Show parameter on"
192 gdb_test "guile (print (parameter-value prev-ambig))" "= #t" "parameter value (true)"
193 gdb_test "help show print s" "This command is not documented." "show help"
194 gdb_test "help set print s" "This command is not documented." "set help"
195 gdb_test "help set print" "set print s -- This command is not documented.*" "general help"