X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Feval.impure.lisp;h=9dfbc14bcf3431f9678a5d5ac40afe6791d1f563;hb=d4d6c4b16a3655ce99a87d43f411391363531260;hp=f7803ffa521ee1a1ebcd2bd6574e5990be255c4b;hpb=e049902f5e7c30501d2dbb7a41d058a0c717fc1f;p=sbcl.git diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp index f7803ff..9dfbc14 100644 --- a/tests/eval.impure.lisp +++ b/tests/eval.impure.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. @@ -18,6 +18,9 @@ (cl:in-package :cl-user) +(load "assertoid.lisp") +(use-package "ASSERTOID") + ;;; Until sbcl-0.7.9.x, EVAL was not correctly treating LOCALLY, ;;; MACROLET and SYMBOL-MACROLET, which should preserve top-levelness ;;; of their body forms: @@ -94,9 +97,43 @@ ;;; Bug reported by Paul Dietz: CONSTANTP on a self-evaluating object ;;; must return T - (assert (constantp (find-class 'symbol))) (assert (constantp #p"")) - + +;;; DEFPARAMETER must assign a dynamic variable +(let ((var (gensym))) + (assert (equal (eval `(list (let ((,var 1)) + (defparameter ,var 2) + ,var) + ,var)) + '(1 2)))) + +;;; Bug 264: SYMBOL-MACROLET did not check for a bound SPECIAL +;;; declaration +(assert (raises-error? (progv '(foo) '(1) + (eval '(symbol-macrolet ((foo 3)) + (declare (special foo)) + foo))) + error)) + +;;; MAKE-PACKAGE (and other &key functions) should signal an error +;;; when given a NIL key. This is kind of a compiler test really, but +;;; this'll do as a resting place. +(handler-case + (eval '(make-package "FOO" nil nil)) + (error () :ok) + (:no-error (c) (error "MAKE-PACKAGE succeeded: ~S" c))) + +;;; FUNCTION +(defun function-eq-test () + 'ok) +(trace function-eq-test) +(assert (eq (eval '(function function-eq-test)) + (funcall (compile nil '(lambda () (function function-eq-test)))))) + +;;; No extra output, please +(assert (equal ".." + (with-output-to-string (*standard-output*) + (eval '(progn (princ ".") (let ((x 42)) t) (princ ".")))))) + ;;; success -(sb-ext:quit :unix-status 104)