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