X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Feval.impure.lisp;h=d50708e4fb2cabcd163b684b1f84442077872d70;hb=062283b901155792f65775491aea51481c56faaa;hp=6900d74089bd8f068a11966e1f1ff1f2d1183a1a;hpb=70afa48b26b8242b39a57d55996fc0e0f41c06af;p=sbcl.git diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp index 6900d74..d50708e 100644 --- a/tests/eval.impure.lisp +++ b/tests/eval.impure.lisp @@ -226,7 +226,7 @@ (with-test (:name :toplevel-declare) (assert (raises-error? (eval '(declare (type pathname *scratch*)))))) -(with-test (:name (eval no-compiler-notes)) +(with-test (:name (eval :no-compiler-notes)) (handler-bind ((sb-ext:compiler-note #'error)) (let ((sb-ext:*evaluator-mode* :compile)) (eval '(let ((x 42)) @@ -249,11 +249,49 @@ (simple-type-error () 'error))) t))) -#+sb-eval -(with-test (:name :bug-524707) +(with-test (:name :bug-524707 :skipped-on '(not :sb-eval)) (let ((*evaluator-mode* :interpret) (lambda-form '(lambda (x) (declare (fixnum x)) (1+ x)))) (let ((fun (eval lambda-form))) (assert (equal lambda-form (function-lambda-expression fun)))))) +(with-test (:name (eval :source-context-in-compiler)) + (let ((noise (with-output-to-string (*error-output*) + (let ((*evaluator-mode* :compile)) + (eval `(defun source-context-test (x) y)))))) + (with-input-from-string (s noise) + (assert (equal "; in: DEFUN SOURCE-CONTEXT-TEST" (read-line s)))))) + +(with-test (:name (eval :empty-let-is-not-toplevel)) + (let ((sb-ext:*evaluator-mode* :compile)) + (eval `(let () + (defmacro empty-let-is-not-toplevel-x () :macro) + (defun empty-let-is-not-toplevel-fun () + (empty-let-is-not-toplevel-x)))) + (eval `(defun empty-let-is-not-toplevel-x () :fun)) + (assert (eq :fun (empty-let-is-not-toplevel-fun)))) + ;; While at it, test that we get the late binding under + ;; interpreter mode. + #+sb-eval + (let ((sb-ext:*evaluator-mode* :interpret)) + (eval `(let () + (defmacro empty-let-is-not-toplevel-x () :macro) + (defun empty-let-is-not-toplevel-fun () + (empty-let-is-not-toplevel-x)))) + (assert (eq :macro (empty-let-is-not-toplevel-fun))) + (eval `(defun empty-let-is-not-toplevel-x () :fun)) + (assert (eq :fun (empty-let-is-not-toplevel-fun))))) + +(with-test (:name (eval function-lambda-expression)) + (assert (equal `(sb-int:named-lambda eval-fle-1 (x) + (block eval-fle-1 + (+ x 1))) + (function-lambda-expression + (eval `(progn + (defun eval-fle-1 (x) (+ x 1)) + #'eval-fle-1))))) + (assert (equal `(lambda (x y z) (+ x 1 y z)) + (function-lambda-expression + (eval `(lambda (x y z) (+ x 1 y z))))))) + ;;; success