mirror of
git://git.gnupg.org/gnupg.git
synced 2025-04-13 22:21:09 +02:00
tests: Refine exception handling.
* tests/gpgscm/init.scm (catch): Bind all arguments to '*error*' in the error handler, update and fix comment. (*error-hook*): Revert to original definition. * tests/gpgscm/tests.scm (tr:do): Adapt accordingly. * tests/openpgp/issue2419.scm: Likewise. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
83a406b38a
commit
ab483eff9a
@ -544,13 +544,14 @@
|
|||||||
;
|
;
|
||||||
; "Catch" establishes a scope spanning multiple call-frames until
|
; "Catch" establishes a scope spanning multiple call-frames until
|
||||||
; another "catch" is encountered. Within the recovery expression
|
; another "catch" is encountered. Within the recovery expression
|
||||||
; the thrown exception is bound to *error*.
|
; the thrown exception is bound to *error*. Errors can be rethrown
|
||||||
|
; using (apply throw *error*).
|
||||||
;
|
;
|
||||||
; Exceptions are thrown with:
|
; Exceptions are thrown with:
|
||||||
;
|
;
|
||||||
; (throw "message")
|
; (throw "message")
|
||||||
;
|
;
|
||||||
; If used outside a (catch ...), reverts to (error "message)
|
; If used outside a (catch ...), reverts to (error "message")
|
||||||
|
|
||||||
(define *handlers* (list))
|
(define *handlers* (list))
|
||||||
|
|
||||||
@ -573,13 +574,12 @@
|
|||||||
(macro (catch form)
|
(macro (catch form)
|
||||||
(let ((label (gensym)))
|
(let ((label (gensym)))
|
||||||
`(call/cc (lambda (**exit**)
|
`(call/cc (lambda (**exit**)
|
||||||
(push-handler (lambda (*error*) (**exit** ,(cadr form))))
|
(push-handler (lambda *error* (**exit** ,(cadr form))))
|
||||||
(let ((,label (begin ,@(cddr form))))
|
(let ((,label (begin ,@(cddr form))))
|
||||||
(pop-handler)
|
(pop-handler)
|
||||||
,label)))))
|
,label)))))
|
||||||
|
|
||||||
(define (*error-hook* . args)
|
(define *error-hook* throw)
|
||||||
(throw args))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
|
;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
|
||||||
|
@ -411,7 +411,7 @@
|
|||||||
(if error
|
(if error
|
||||||
(begin
|
(begin
|
||||||
(for-each remove-temporary-file tmpfiles')
|
(for-each remove-temporary-file tmpfiles')
|
||||||
(throw error)))
|
(apply throw error)))
|
||||||
(loop tmpfiles' sink (cdr cmds))))))
|
(loop tmpfiles' sink (cdr cmds))))))
|
||||||
|
|
||||||
(define (tr:open pathname)
|
(define (tr:open pathname)
|
||||||
|
@ -23,6 +23,6 @@
|
|||||||
(lettmp
|
(lettmp
|
||||||
(onebyte)
|
(onebyte)
|
||||||
(dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
|
(dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
|
||||||
(catch (assert (string-contains? *error* "invalid packet"))
|
(catch (assert (string-contains? (car *error*) "invalid packet"))
|
||||||
(call-popen `(,@GPG --list-packets ,onebyte) "")
|
(call-popen `(,@GPG --list-packets ,onebyte) "")
|
||||||
(error "Expected an error but got none")))
|
(error "Expected an error but got none")))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user