mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 17:00:23 +02:00
Code Activity

(run-test-exception): Add special handling for

Browse source 
`error'-generated exceptions, which pass key
`misc-error' and leave messages unformatted.
This commit is contained in:
Thien-Thi Nguyen 2001-08-01 10:04:03 +00:00
parent cd3b769056
commit 15a683e30c
1 changed files with 45 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

17
test-suite/lib.scm
View file

@ -288,9 +288,20 @@
(stack-catch (car exception) (stack-catch (car exception)
(lambda () (thunk) #f) (lambda () (thunk) #f)
(lambda (key proc message . rest) (lambda (key proc message . rest)
(if (not (string-match (cdr exception) message)) (cond
(apply throw key proc message rest) ;; handle explicit key
#t)))))) ((string-match (cdr exception) message)
#t)
;; handle `(error ...)' which uses `misc-error' for key and doesn't
;; yet format the message and args (we have to do it here).
((and (eq? 'misc-error (car exception))
(list? rest)
(string-match (cdr exception)
(apply simple-format #f message (car rest))))
#t)
;; unhandled; throw again
(else
(apply throw key proc message rest))))))))
;;; A short form for tests that expect a certain exception to be thrown. ;;; A short form for tests that expect a certain exception to be thrown.
(defmacro pass-if-exception (name exception body . rest) (defmacro pass-if-exception (name exception body . rest)