X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fload.impure.lisp;h=ee43f50411f11b4a9da3804107ec3f84a2f7d383;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=78b6d5c8fb5acd15e93dac7e02f5abd19818ded5;hpb=e2574c9090a19634f1f903a9f0c229960edfd7b6;p=sbcl.git

diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
index 78b6d5c..ee43f50 100644
--- a/tests/load.impure.lisp
+++ b/tests/load.impure.lisp
@@ -55,18 +55,17 @@
 
 ;;; As reported by David Tolpin *LOAD-PATHNAME* was not merged.
 (progn
-  (defvar *saved-load-pathname*)
+  (defparameter *saved-load-pathname* nil)
   (with-open-file (s *tmp-filename*
                      :direction :output
                      :if-exists :supersede
                      :if-does-not-exist :create)
     (print '(setq *saved-load-pathname* *load-pathname*) s))
-  (let (tmp-fasl)
-    (unwind-protect
-         (progn
-           (load *tmp-filename*)
-           (assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*)))
-      (delete-file *tmp-filename*))))
+  (unwind-protect
+       (progn
+         (load *tmp-filename*)
+         (assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*)))
+    (delete-file *tmp-filename*)))
 
 ;;; Test many, many variations on LOAD.
 (defparameter *counter* 0)
@@ -84,8 +83,10 @@
            *loaded-pathname* *loaded-truename*)
        (load ,load-argument :print t :verbose t)
        (assert (and (= (1+ ,before) *counter*)
+                    #-win32 ;kludge
                     (equal ,(if pathname `(merge-pathnames ,pathname))
                            *loaded-pathname*)
+                    #-win32 ;kludge
                     (equal ,(if pathname `(merge-pathnames ,truename))
                            *loaded-truename*))))))
 
@@ -252,9 +253,9 @@
                                        :if-exists :append)
       (write-line ";;comment"))
     (handler-bind ((error (lambda (error)
-                                   (declare (ignore error))
-                                   (when (find-restart 'sb-fasl::source)
-                                     (invoke-restart 'sb-fasl::source)))))
+                            (declare (ignore error))
+                            (when (find-restart 'sb-fasl::source)
+                              (invoke-restart 'sb-fasl::source)))))
       (load-and-assert spec source source))))
 
 ;; Ensure that we can invoke the restart OBJECT in the above case.
@@ -267,14 +268,20 @@
                                        :if-exists :append)
       (write-line ";;comment"))
     (handler-bind ((error (lambda (error)
-                                   (declare (ignore error))
-                                   (when (find-restart 'sb-fasl::object)
-                                     (invoke-restart 'sb-fasl::object)))))
+                            (declare (ignore error))
+                            (when (find-restart 'sb-fasl::object)
+                              (invoke-restart 'sb-fasl::object)))))
       (load-and-assert spec fasl fasl))))
 
 (with-test (:name :bug-332)
   (flet ((stimulate-sbcl ()
-           (let ((filename (format nil "/tmp/~A.lisp" (gensym))))
+           (let ((filename
+                  (format nil "~A/~A.lisp"
+                          (or (posix-getenv "TEST_DIRECTORY")
+                              (posix-getenv "TMPDIR")
+                              "/tmp")
+                          (gensym))))
+             (ensure-directories-exist filename)
              ;; create a file which redefines a structure incompatibly
              (with-open-file (f filename :direction :output :if-exists :supersede)
                (print '(defstruct bug-332 foo) f)
@@ -300,10 +307,10 @@
                (error () nil)))
         (ignore-errors (delete-file pathname)))))
 
-(with-test (:name (load "empty.lisp"))
+(with-test (:name (load :empty.lisp))
   (assert (load-empty-file "lisp")))
 
-(with-test (:name (load "empty.fasl"))
+(with-test (:name (load :empty.fasl))
   (assert (not (load-empty-file "fasl"))))
 
 (with-test (:name :parallel-fasl-load)
@@ -351,3 +358,61 @@
                  (test-it)))))
       (when fasl
         (ignore-errors (delete-file fasl))))))
+
+(defvar *pack*)
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-int)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-ub64 2 4)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack integer)))
+             (assert (= 2 (sb-kernel:%simd-pack-low *pack*)))
+             (assert (= 4 (sb-kernel:%simd-pack-high *pack*)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))
+
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-single)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-single 1f0 2f0 3f0 4f0)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack single-float)))
+             (assert (equal (multiple-value-list (sb-kernel:%simd-pack-singles *pack*))
+                            '(1f0 2f0 3f0 4f0)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))
+
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-double)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-double 1d0 2d0)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack double-float)))
+             (assert (equal (multiple-value-list (sb-kernel:%simd-pack-doubles *pack*))
+                            '(1d0 2d0)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))