a9f116cbf2
have empty bodies. User-defined commands that have empty bodies weren't being shown because the print function returned too soon. Now, it prints the command's name before checking if it has any body at all. This also fixes the same problem on "show user <myemptycommand>", which wasn't being printed due to a similar reason. gdb/Changelog: * cli/cli-cmds.c (show_user): Use cli_user_command_p to decide whether we display the command on "show user". * cli/cli-script.c (show_user_1): Only verify cmdlines after printing command name. * cli/cli-decode.h (cli_user_command_p): Declare new function. * cli/cli-decode.c (cli_user_command_p): Create helper function to verify whether cmd_list_element is a user-defined command. gdb/testsuite/Changelog: * gdb.base/commands.exp: Add tests to verify user-defined commands with empty bodies. * gdb.python/py-cmd.exp: Test that we don't show user-defined python commands in `show user command`. * gdb.python/scm-cmd.exp: Test that we don't show user-defined scheme commands in `show user command`.
202 lines
7.1 KiB
Text
202 lines
7.1 KiB
Text
# Copyright (C) 2009-2013 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 ${testfile}.exp ${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)"
|