1# Copyright 2010-2016 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# Usage: gdb_test_multiline NAME INPUT RESULT {INPUT RESULT} ... 58# Run a test named NAME, consisting of multiple lines of input. 59# After each input line INPUT, search for result line RESULT. 60# Succeed if all results are seen; fail otherwise. 61# FIXME: Move to gdb.exp and remove Python's gdb_py_test_multiple. 62 63proc gdb_test_multiline { name args } { 64 global gdb_prompt 65 foreach {input result} $args { 66 if {[gdb_test_multiple $input "$name - $input" { 67 -re "\[\r\n\]*($result)\[\r\n\]+($gdb_prompt | *>)$" { 68 pass "$name - $input" 69 } 70 }]} { 71 return 1 72 } 73 } 74 return 0 75} 76 77# Load Scheme file FILE_NAME. 78# TEST_NAME can be used to specify the name of the test, 79# otherwise a standard test name is provided. 80# 81# Note: When Guile loads something and auto-compilation is enabled 82# (which is useful and the default), then the first time a file is loaded 83# Guile will compile the file and store the result somewhere 84# (e.g., $HOME/.cache/guile). Output of the compilation process will 85# appear in gdb.log. But since Guile only does this when necessary 86# don't be confused if you don't always see it - Guile just skipped it 87# because it thought it was unnecessary. 88 89proc gdb_scm_load_file { file_name {test_name ""} } { 90 if { $test_name == "" } { 91 set test_name "guile (load \"[file tail $file_name]\")" 92 } 93 # Note: This can produce output if Guile compiles the file. 94 gdb_scm_test_silent_cmd "guile (load \"$file_name\")" $test_name 95} 96 97# Install various utilities in Guile to simplify tests. 98# 99# print - combination of display + newline 100 101proc gdb_install_guile_utils { } { 102 # Define utilities in Guile to save needing (newline) all the time, 103 # and in the case of "print" add a prefix to help erroneous passes. 104 gdb_test_no_output "guile (define (print x) (format #t \"= ~A\" x) (newline))" 105 gdb_test_no_output "guile (define (raw-print x) (format #t \"= ~S\" x) (newline))" 106} 107 108# Install the gdb module. 109 110proc gdb_install_guile_module { } { 111 gdb_test_no_output "guile (use-modules (gdb))" 112} 113 114# Wrapper around runto_main that installs the guile utils and module. 115# The result is the same as for runto_main. 116 117proc gdb_guile_runto_main { } { 118 if ![runto_main] { 119 fail "Can't run to main" 120 return 0 121 } 122 123 gdb_install_guile_utils 124 gdb_install_guile_module 125 126 return 1 127} 128