1# Copyright 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# Utilities for Guile-scripting related tests. 17 18# Guile doesn't print the 0x prefix on hex numbers. 19set ghex {[0-9a-f]+} 20 21# Return a 1 for configurations that do not support Guile scripting. 22 23proc skip_guile_tests {} { 24 global gdb_prompt 25 26 gdb_test_multiple "guile (display \"test\\n\")" "verify guile support" { 27 -re "Undefined command.*$gdb_prompt $" { 28 unsupported "Guile not supported." 29 return 1 30 } 31 -re "not supported.*$gdb_prompt $" { 32 unsupported "Guile support is disabled." 33 return 1 34 } 35 -re "$gdb_prompt $" {} 36 } 37 38 return 0 39} 40 41# Run a command in GDB, and report a failure if a Scheme exception is thrown. 42# If report_pass is true, report a pass if no exception is thrown. 43# This also catches the "Undefined command" error that happens if the user 44# passes, e.g., "(print foo)" instead of "guile (print foo)". 45 46proc gdb_scm_test_silent_cmd { cmd name {report_pass 1} } { 47 global gdb_prompt 48 49 gdb_test_multiple $cmd $name { 50 -re "Backtrace.*$gdb_prompt $" { fail $name } 51 -re "ERROR.*$gdb_prompt $" { fail $name } 52 -re "Undefined command: .*$gdb_prompt $" { fail $name } 53 -re "$gdb_prompt $" { if $report_pass { pass $name } } 54 } 55} 56 57# Load Scheme file FILE_NAME. 58# TEST_NAME can be used to specify the name of the test, 59# otherwise a standard test name is provided. 60# 61# Note: When Guile loads something and auto-compilation is enabled 62# (which is useful and the default), then the first time a file is loaded 63# Guile will compile the file and store the result somewhere 64# (e.g., $HOME/.cache/guile). Output of the compilation process will 65# appear in gdb.log. But since Guile only does this when necessary 66# don't be confused if you don't always see it - Guile just skipped it 67# because it thought it was unnecessary. 68 69proc gdb_scm_load_file { file_name {test_name ""} } { 70 if { $test_name == "" } { 71 set test_name "guile (load \"[file tail $file_name]\")" 72 } 73 # Note: This can produce output if Guile compiles the file. 74 gdb_scm_test_silent_cmd "guile (load \"$file_name\")" $test_name 75} 76 77# Install various utilities in Guile to simplify tests. 78# 79# print - combination of display + newline 80 81proc gdb_install_guile_utils { } { 82 # Define utilities in Guile to save needing (newline) all the time, 83 # and in the case of "print" add a prefix to help erroneous passes. 84 gdb_test_no_output "guile (define (print x) (format #t \"= ~A\" x) (newline))" 85 gdb_test_no_output "guile (define (raw-print x) (format #t \"= ~S\" x) (newline))" 86} 87 88# Install the gdb module. 89 90proc gdb_install_guile_module { } { 91 gdb_test_no_output "guile (use-modules (gdb))" 92} 93 94# Wrapper around runto_main that installs the guile utils and module. 95# The result is the same as for runto_main. 96 97proc gdb_guile_runto_main { } { 98 if ![runto_main] { 99 fail "can't run to main" 100 return 0 101 } 102 103 gdb_install_guile_utils 104 gdb_install_guile_module 105 106 return 1 107} 108