;;;; more information.
#-sb-eval
-(sb-ext:quit :unix-status 104)
+(sb-ext:exit :code 104)
(setf sb-ext:*evaluator-mode* :interpret)
(funcall fun)
(assert (gethash '(when t nil) seen-forms)))))
+;;; defstruct constructor
+(let ((sb-ext:*evaluator-mode* :interpret))
+ (eval '(progn
+ (defstruct evaluated-struct
+ (pointer nil)
+ (word 0 :type (unsigned-byte #.sb-vm:n-word-bytes))
+ (single 0.0 :type single-float)
+ (double 0.0d0 :type double-float)
+ (csingle (complex 0.0 0.0) :type (complex single-float))
+ (cdouble (complex 0.0d0 0.0d0) :type (complex double-float)))
+ (defvar *evaluated-struct* (make-evaluated-struct
+ :pointer :foo
+ :word 42
+ :single 1.23
+ :double 2.34d0
+ :csingle (complex 1.0 2.0)
+ :cdouble (complex 2.0d0 3.0d0)))
+ (assert (eq :foo (evaluated-struct-pointer *evaluated-struct*)))
+ (assert (eql 42 (evaluated-struct-word *evaluated-struct*)))
+ (assert (eql 1.23 (evaluated-struct-single *evaluated-struct*)))
+ (assert (eql 2.34d0 (evaluated-struct-double *evaluated-struct*)))
+ (assert (eql #c(1.0 2.0) (evaluated-struct-csingle *evaluated-struct*)))
+ (assert (eql #c(2.0d0 3.0d0) (evaluated-struct-cdouble *evaluated-struct*))))))
+
+;;; Prior to 1.0.25, the interpreter checked for package lock
+;;; violation for a local function in the fbinding form's body's
+;;; lexical environment.
+(let ((sb-ext:*evaluator-mode* :interpret))
+ (assert
+ (ignore-errors
+ (eval
+ '(eql
+ (locally (declare (disable-package-locks
+ ;; rather than create a whole new package
+ ;; just to test this corner case, we'll
+ ;; lexically shadow something innocuous in
+ ;; the CL package.
+ cl:ed))
+ (flet ((cl:ed ()
+ 42))
+ (declare (enable-package-locks cl:ed))
+ (cl:ed)))
+ 42)))))
+
+(defvar *file* #p"full-eval-temp.lisp")
+(with-test (:name (:full-eval :redefinition-warnings))
+ (with-open-file (stream *file* :direction :output :if-exists :supersede)
+ (write '(defun function-for-redefinition () nil) :stream stream))
+ (handler-bind ((warning #'error))
+ (let ((sb-ext:*evaluator-mode* :interpret))
+ (load *file*)
+ (load *file*))
+ (let ((sb-ext:*evaluator-mode* :compile))
+ (load *file*))))
+(delete-file *file*)
+
+(defvar *stash*)
+(defun save-it (f) (setq *stash* f) 'whatever)
+(with-test (:name (let* :nested-environments))
+ (let ((z 'zee) (y 'y) (x 92))
+ (let* ((baz (save-it (lambda (what) (assert (equal (list what x y z)
+ (list what 92 'y 'zee))))))
+ (mum (funcall *stash* :after-binding-baz))
+ (y 'new-y)
+ (z (progn (funcall *stash* :after-binding-y) 'new-z))
+ (x (progn (funcall *stash* :after-binding-z) 'new-x)))
+ (funcall *stash* :in-body)
+ (values))))
+
+(with-test (:name (let* :nested-environment-again))
+ (let* ((foo 3)
+ (foo (lambda () (typep foo 'integer))))
+ (assert (funcall foo))))