tests/destructure.impure.lisp

   1 ;;;; tests, with side effects, of DESTRUCTURING-BIND-ish functionality
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 ;;; In sbcl-1.0.7.8, the printer for the ERROR condition signalled from
  15 ;;;   (DESTRUCTURING-BIND (...) 1 ...)
  16 ;;; contained the implicit assumption that the bad datum was a list,
  17 ;;; so that attempting to print the condition caused a new error.
  18 (defun frob-1-0-7-8 (x)
  19   (destructuring-bind (y . z) x
  20     (print y)
  21     (print z)))
  22 (multiple-value-bind (whatever error)
  23     (ignore-errors (frob-1-0-7-8 1))
  24   (declare (ignore whatever))
  25   (princ error)) ; shouldn't cause an error
  26
  27 (with-test (:name :destruring-bind-atom-good-error)
  28   (let ((c (make-condition 'sb-kernel::arg-count-error
  29                            :args 'x
  30                            :lambda-list '(a . b)
  31                            :minimum 1
  32                            :maximum nil
  33                            :name 'foo
  34                            :kind 'macro)))
  35     (write-to-string c :escape nil))
  36   (let ((c (make-condition 'sb-kernel::arg-count-error
  37                            :args '(x . y)
  38                            :lambda-list '(a b . c)
  39                            :minimum 1
  40                            :maximum nil
  41                            :name 'foo
  42                            :kind 'macro)))
  43     (write-to-string c :escape nil)))