1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
# Copyright (C) 2009-2017 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 the mechanism
# for defining new GDB commands in Scheme.
load_lib gdb-guile.exp
standard_testfile
if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
return
}
# Skip all tests if Guile scripting is not enabled.
if { [skip_guile_tests] } { continue }
if ![gdb_guile_runto_main] {
fail "can't run to main"
return
}
# Test a simple command, and command? while we're at it.
gdb_test_multiline "input simple command" \
"guile" "" \
"(define test-cmd" "" \
" (make-command \"test-cmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"test-cmd output, arg = ~a\\n\" arg)))))" "" \
"(register-command! test-cmd)" "" \
"end" ""
gdb_test "guile (print (command? test-cmd))" "= #t"
gdb_test "guile (print (command? 42))" "= #f"
gdb_test "test-cmd ugh" "test-cmd output, arg = ugh" "call simple command"
# Test a prefix command, and a subcommand within it.
gdb_test_multiline "input prefix command" \
"guile" "" \
"(register-command! (make-command \"prefix-cmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:completer-class COMPLETE_NONE" "" \
" #:prefix? #t" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"prefix-cmd output, arg = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "prefix-cmd ugh" "prefix-cmd output, arg = ugh" "call prefix command"
gdb_test_multiline "input subcommand" \
"guile" "" \
"(register-command! (make-command \"prefix-cmd subcmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"subcmd output, arg = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "prefix-cmd subcmd ugh" "subcmd output, arg = ugh" "call subcmd"
# Test a subcommand in an existing GDB prefix.
gdb_test_multiline "input new subcommand" \
"guile" "" \
"(register-command! (make-command \"info newsubcmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"newsubcmd output, arg = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "info newsubcmd ugh" "newsubcmd output, arg = ugh" "call newsubcmd"
# Test a command that throws gdb:user-error.
gdb_test_multiline "input command to throw error" \
"guile" "" \
"(register-command! (make-command \"test-error-cmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (throw-user-error \"you lose! ~a\" arg))))" "" \
"end" ""
gdb_test "test-error-cmd ugh" "ERROR: you lose! ugh" "call error command"
# Test string->argv.
gdb_test "guile (raw-print (string->argv \"1 2 3\"))" \
{= \("1" "2" "3"\)} \
"(string->argv \"1 2 3\")"
gdb_test "guile (raw-print (string->argv \"'1 2' 3\"))" \
{= \("1 2" "3"\)} \
"(string->argv \"'1 2' 3\")"
gdb_test "guile (raw-print (string->argv \"\\\"1 2\\\" 3\"))" \
{= \("1 2" "3"\)} \
"(string->argv (\"\\\"1 2\\\" 3\")"
gdb_test "guile (raw-print (string->argv \"1\\\\ 2 3\"))" \
{= \("1 2" "3"\)} \
"(string->argv \"1\\\\ 2 3\")"
# Test user-defined guile commands.
gdb_test_multiline "input simple user-defined command" \
"guile" "" \
"(register-command! (make-command \"test-help\"" "" \
" #:doc \"Docstring\"" "" \
" #:command-class COMMAND_USER" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"test-cmd output, arg = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "test-help ugh" "test-cmd output, arg = ugh" \
"call simple user-defined command"
# Make sure the command shows up in `help user-defined`.
gdb_test "help user-defined" \
"User-defined commands.\[\r\n\]+The commands in this class are those defined by the user.\[\r\n\]+Use the \"define\" command to define a command.\[\r\n\]+List of commands:\[\r\n\]+test-help -- Docstring\[\r\n\]+Type \"help\" followed by command name for full documentation.\[\r\n\]+Type \"apropos word\" to search for commands related to \"word\".\[\r\n\]+Command name abbreviations are allowed if unambiguous.\[\r\n\]+" \
"see user-defined command in `help user-defined`"
# Make sure the command does not show up in `show user`.
gdb_test "show user test-help" "Not a user command\." \
"don't show user-defined scheme command in `show user command`"
# Test expression completion on fields.
gdb_test_multiline "expression completion command" \
"guile" "" \
"(register-command! (make-command \"expr-test\"" "" \
" #:command-class COMMAND_USER" ""\
" #:completer-class COMPLETE_EXPRESSION" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"invoked on = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "complete expr-test bar\." \
"expr-test bar\.bc.*expr-test bar\.ij.*" \
"test completion through complete command"
set test "complete 'expr-test bar.i'"
send_gdb "expr-test bar\.i\t\t"
gdb_test_multiple "" "$test" {
-re "expr-test bar\.ij \\\x07$" {
send_gdb "\n"
gdb_test_multiple "" $test {
-re "invoked on = bar.ij.*$gdb_prompt $" {
pass "$test"
}
}
}
}
# Test using a function for completion.
gdb_test_multiline "completer-as-function command" \
"guile" "" \
"(register-command! (make-command \"completer-as-function\"" "" \
" #:command-class COMMAND_USER" ""\
" #:completer-class (lambda (self text word)" "" \
" (list \"1\" \"2\" \"3\"))" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" (display (format #f \"invoked on = ~a\\n\" arg)))))" "" \
"end" ""
gdb_test "complete completer-as-function 42\." \
"completer-as-function 42\.1.*completer-as-function 42\.2.*completer-as-function 42\.3" \
"test completion with completion function"
# Test Scheme error in invoke function.
gdb_test_multiline "input command with Scheme error" \
"guile" "" \
"(register-command! (make-command \"test-scheme-error-cmd\"" "" \
" #:command-class COMMAND_OBSCURE" "" \
" #:invoke (lambda (self arg from-tty)" "" \
" oops-bad-spelling)))" "" \
"end" ""
gdb_test "test-scheme-error-cmd ugh" \
"Error occurred in Scheme-implemented GDB command." \
"call scheme-error command"
# If there is a problem with object management, this can often trigger it.
# It is useful to do this last, after we've created a bunch of command objects.
gdb_test_no_output "guile (gc)"
|
