common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

tests: Use WITH-TEST in destructure.impure.lisp

Browse source
This commit is contained in:
Jan Moringen 2017-08-31 20:18:35 +02:00
parent 92b94ce2ab
commit 05004b2c6c
1 changed files with 8 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
tests/destructure.impure.lisp
View file

@ -16,15 +16,13 @@
;;; contained the implicit assumption that the bad datum was a list,
;;; so that attempting to print the condition caused a new error.
(defun frob-1-0-7-8 (x)
(destructuring-bind (y . z) x
(print y)
(print z)))
(multiple-value-bind (whatever error)
(ignore-errors (frob-1-0-7-8 1))
(declare (ignore whatever))
(princ error)) ; shouldn't cause an error
(destructuring-bind (y . z) x (list y z)))
(with-test (:name (destructuring-bind :dotted-list error :printable 1))
(let ((error (nth-value 1 (ignore-errors (frob-1-0-7-8 1)))))
;; Printing ERROR shouldn't cause an error.
(assert (search "(Y . Z)" (princ-to-string error)))))
(with-test (:name :destruring-bind-atom-good-error)
(with-test (:name (destructuring-bind :dotted-list error :printable 2))
(let ((c (make-condition 'sb-kernel::arg-count-error
:args 'x
:lambda-list '(a . b)
@ -32,7 +30,7 @@
:maximum nil
:name 'foo
:kind 'macro)))
(write-to-string c :escape nil))
(assert (search "(A . B)" (write-to-string c :escape nil))))
(let ((c (make-condition 'sb-kernel::arg-count-error
:args '(x . y)
:lambda-list '(a b . c)
@ -40,4 +38,4 @@
:maximum nil
:name 'foo
:kind 'macro)))
(write-to-string c :escape nil)))
(assert (search "(A B . C)" (write-to-string c :escape nil)))))