1184610Salfred# Copyright (C) 2010-2023 Free Software Foundation, Inc. 2184610Salfred 3184610Salfred# This program is free software; you can redistribute it and/or modify 4184610Salfred# it under the terms of the GNU General Public License as published by 5184610Salfred# the Free Software Foundation; either version 3 of the License, or 6184610Salfred# (at your option) any later version. 7184610Salfred# 8184610Salfred# This program is distributed in the hope that it will be useful, 9184610Salfred# but WITHOUT ANY WARRANTY; without even the implied warranty of 10184610Salfred# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11184610Salfred# GNU General Public License for more details. 12184610Salfred# 13184610Salfred# You should have received a copy of the GNU General Public License 14184610Salfred# along with this program. If not, see <http://www.gnu.org/licenses/>. 15184610Salfred 16184610Salfred# Test various error conditions. 17184610Salfred 18184610Salfredset testfile "scm-error" 19184610Salfred 20184610Salfredload_lib gdb-guile.exp 21184610Salfred 22184610Salfred# Start with a fresh gdb. 23184610Salfredgdb_exit 24184610Salfredgdb_start 25184610Salfred 26184610Salfred# Skip all tests if Guile scripting is not enabled. 27184610Salfredif { [skip_guile_tests] } { continue } 28184610Salfred 29184610Salfred# Test error while loading .scm. 30184610Salfred 31184610Salfredset remote_guile_file_1 [gdb_remote_download host \ 32184610Salfred ${srcdir}/${subdir}/${testfile}-1.scm] 33184610Salfredset remote_guile_file_2 [gdb_remote_download host \ 34184610Salfred ${srcdir}/${subdir}/${testfile}-2.scm] 35190754Sthompsa 36184610Salfredgdb_test "source $remote_guile_file_1" \ 37184610Salfred "(ERROR: )?In procedure \[+\]: Wrong type.*: #f.*" \ 38188942Sthompsa "error loading scm file caught" 39188942Sthompsa 40188942Sthompsagdb_test "p 1" " = 1" "no delayed error" 41184610Salfred 42184610Salfred# Test setting/showing the various states for "guile print-stack". 43184610Salfred 44188942Sthompsagdb_test "show guile print-stack" \ 45188942Sthompsa "The mode of Guile exception printing on error is \"message\".*" \ 46188942Sthompsa "test print-stack show setting of default" 47188942Sthompsagdb_test_no_output "set guile print-stack full" \ 48188942Sthompsa "test print-stack full setting" 49188942Sthompsagdb_test "show guile print-stack" \ 50188942Sthompsa "The mode of Guile exception printing on error is \"full\".*" \ 51188942Sthompsa "test print-stack show setting to full" 52184610Salfredgdb_test_no_output "set guile print-stack none" \ 53188942Sthompsa "test print-stack none setting" 54188942Sthompsagdb_test "show guile print-stack" \ 55188942Sthompsa "The mode of Guile exception printing on error is \"none\".*" \ 56184610Salfred "test print-stack show setting to none" 57190181Sthompsa# Reset back to default, just in case. 58190181Sthompsagdb_test_no_output "set guile print-stack message" \ 59190181Sthompsa "reset print-stack to default, post set/show tests" 60184610Salfred 61184610Salfred# Test "set guile print-stack none". 62184610Salfred 63184610Salfredgdb_test_no_output "set guile print-stack none" \ 64192502Sthompsa "set print-stack to none, for error test" 65192502Sthompsa 66184610Salfredset test_name "no error printed" 67184610Salfredset command "guile (define x doesnt-exist)" 68184610Salfredgdb_test_multiple $command $test_name { 69184610Salfred -re "Backtrace.*$gdb_prompt $" { fail $test_name } 70184610Salfred -re "ERROR.*$gdb_prompt $" { fail $test_name } 71184610Salfred -re "$gdb_prompt $" { pass $test_name } 72184610Salfred} 73184610Salfred 74184610Salfred# Test "set guile print-stack message". 75184610Salfred 76184610Salfredgdb_test_no_output "set guile print-stack message" \ 77184610Salfred "set print-stack to message, for error test" 78184610Salfred 79184610Salfredset test_name "error message printed" 80184610Salfredset command "guile (define x doesnt-exist)" 81184610Salfredgdb_test_multiple $command $test_name { 82184610Salfred -re "Backtrace.*$gdb_prompt $" { fail $test_name } 83184610Salfred -re "ERROR.*$gdb_prompt $" { pass $test_name } 84184610Salfred} 85184610Salfred 86184610Salfred# Test "set guile print-stack full". 87184610Salfred 88184610Salfredgdb_scm_test_silent_cmd "source $remote_guile_file_2" "" 89184610Salfred 90192984Sthompsagdb_test_no_output "set guile print-stack full" \ 91192984Sthompsa "set print-stack to full, for backtrace test" 92192984Sthompsa 93192984Sthompsagdb_test "guile (define x (top-func 42))" \ 94192984Sthompsa "Guile Backtrace:.*top-func (42|_).*middle-func (42|_).*bottom-func (42|_).*" \ 95184610Salfred "backtrace printed" 96192984Sthompsa 97193045Sthompsa# Verify gdb-specific errors are printed properly. 98184610Salfred# i.e., each gdb error is registered to use init.scm:%error-printer. 99192984Sthompsa 100190735Sthompsagdb_test_no_output "set guile print-stack message" \ 101184610Salfred "set print-stack to message, for error printing tests" 102184610Salfred 103192984Sthompsagdb_test "guile (throw 'gdb:error \"subr\" \"misc error: ~a\" (list 42))" \ 104184610Salfred "ERROR: In procedure subr: misc error: 42.*" 105184610Salfred 106184610Salfredgdb_test "guile (throw 'gdb:invalid-object-error \"subr\" \"invalid object error: ~a\" (list 42))" \ 107184610Salfred "ERROR: In procedure subr: invalid object error: 42.*" 108184610Salfred 109184610Salfredgdb_test "guile (throw 'gdb:memory-error \"subr\" \"memory error: ~a\" (list 42))" \ 110184610Salfred "ERROR: In procedure subr: memory error: 42.*" 111184610Salfred 112190183Sthompsagdb_test "guile (throw 'gdb:pp-type-error \"subr\" \"pp-type error: ~a\" (list 42))" \ 113184610Salfred "ERROR: In procedure subr: pp-type error: 42.*" 114184610Salfred