X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.pure.lisp;h=377c7e887fcc2e1e909223df06d7f31722195a18;hb=40e3ba03d0e1b824e4d1ae75d74246b975b70964;hp=b110f27c48698c141ce64765c9a06982591a991f;hpb=febd370c0e4a2f18cac9e4ccb0a16022ac6fc298;p=sbcl.git diff --git a/tests/clos.pure.lisp b/tests/clos.pure.lisp index b110f27..377c7e8 100644 --- a/tests/clos.pure.lisp +++ b/tests/clos.pure.lisp @@ -6,7 +6,7 @@ ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. -;;;; +;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. @@ -19,22 +19,22 @@ ;;; depends on it. The basic functionality is tested elsewhere, but ;;; this is to investigate the internals for possible inconsistency. (assert (null - (let (collect) - (sb-pcl::map-all-generic-functions - (lambda (gf) - (let ((arg-info (sb-pcl::gf-arg-info gf))) - (when (eq (sb-pcl::arg-info-lambda-list arg-info) - :no-lambda-list) - (push gf collect))))) - (print (nreverse collect))))) + (let (collect) + (sb-pcl::map-all-generic-functions + (lambda (gf) + (let ((arg-info (sb-pcl::gf-arg-info gf))) + (when (eq (sb-pcl::arg-info-lambda-list arg-info) + :no-lambda-list) + (push gf collect))))) + (print (nreverse collect))))) ;;; Regressing test for invalid slot specification error printing -(multiple-value-bind (value err) +(multiple-value-bind (value err) (ignore-errors (macroexpand '(defclass foo () (frob (frob bar))))) (declare (ignore value)) (assert (typep err 'simple-condition)) (multiple-value-bind (value format-err) - (ignore-errors (apply #'format nil + (ignore-errors (apply #'format nil (simple-condition-format-control err) (simple-condition-format-arguments err))) (declare (ignore value))