X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffull-eval.impure.lisp;h=032634f189adc7a43e141714105f372073244751;hb=a51d83191034919bc76367268929e234d62164db;hp=a35528cfcd9c2409e9c10f312f8817e46e4c5127;hpb=970dd272dc84f7420252eadb4829cc193f795716;p=sbcl.git

diff --git a/tests/full-eval.impure.lisp b/tests/full-eval.impure.lisp
index a35528c..032634f 100644
--- a/tests/full-eval.impure.lisp
+++ b/tests/full-eval.impure.lisp
@@ -31,3 +31,46 @@
       (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)))))