X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fsmoke.impure.lisp;h=f0069a713c051fa1b376fd78780ac93fba6d0c0a;hb=cf49f2d086069a9c1b57f501df9a6a0bd3a34c3c;hp=d5e86b3b8710f2dbed09aae45a6e40de89ff8954;hpb=d49c71bf00d858efc5796900ca4954fb76ce6402;p=sbcl.git diff --git a/tests/smoke.impure.lisp b/tests/smoke.impure.lisp index d5e86b3..f0069a7 100644 --- a/tests/smoke.impure.lisp +++ b/tests/smoke.impure.lisp @@ -7,7 +7,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. @@ -31,13 +31,14 @@ (assert (typep (in-package :cl-user) 'package)) ;;; PROFILE should run without obvious breakage -(defun profiled-fun () - (random 1d0)) -(profile profiled-fun) -(loop repeat 100000 do (profiled-fun)) -(report) +(progn + (defun profiled-fun () + (random 1d0)) + (profile profiled-fun) + (loop repeat 100000 do (profiled-fun)) + (report)) -;;; DEFCONSTANT should behave as the documentation specifies, +;;; Defconstant should behave as the documentation specifies, ;;; including documented condition type. (defun oidentity (x) x) (defconstant +const+ 1) @@ -50,14 +51,31 @@ (assert (= (oidentity +const+) 1)) (handler-bind ((sb-ext:defconstant-uneql - (lambda (c) (abort c)))) + (lambda (c) (abort c)))) (defconstant +const+ 3)) (assert (= (oidentity +const+) 1)) (handler-bind ((sb-ext:defconstant-uneql - (lambda (c) (continue c)))) + (lambda (c) (continue c)))) (defconstant +const+ 3)) (assert (= (oidentity +const+) 3)) +;;; MULTIPLE-VALUE-BIND and lambda list keywords +(multiple-value-bind (&rest &optional &key &allow-other-keys) + (values 1 2 3) + (assert (= &rest 1)) + (assert (= &optional 2)) + (assert (= &key 3)) + (assert (null &allow-other-keys))) + +(let ((fn (lambda (&foo &rest &bar) (cons &foo &bar)))) + (assert (equal (funcall fn 1) '(1))) + (assert (equal (funcall fn 1 2 3) '(1 2 3)))) + +;;; Failure to save a core is an error +(with-test (:name :save-lisp-and-die-error) + (assert (eq :oops + (handler-case (save-lisp-and-die "/") + (error () :oops))))) + ;;; success -(quit :unix-status 104)