mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2024-12-09 04:21:49 +08:00
4a94e36819
This commit brings all the changes made by running gdb/copyright.py as per GDB's Start of New Year Procedure. For the avoidance of doubt, all changes in this commits were performed by the script.
200 lines
6.6 KiB
Plaintext
200 lines
6.6 KiB
Plaintext
# Copyright (C) 2009-2022 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] {
|
|
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`.
|
|
test_user_defined_class_help {"test-help -- Docstring[\r\n]"}
|
|
|
|
# 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)"
|