X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure-cload.lisp;h=a6736013e67a832bc290c2eb933bf615587192a5;hb=2fb5b174f6acb88a85c86aa4cd753ddefaccc987;hp=41d052513b935905990dc854308db9c105ac50c7;hpb=636f24460849bdd73284750463439f73d90428ae;p=sbcl.git

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 41d0525..a673601 100644
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -364,20 +364,20 @@
 ;;; failed on Alpha prior to sbcl-0.8.10.30
 (defun lotso-values ()
   (values 0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9
-	  0 1 2 3 4 5 6 7 8 9))
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9
+          0 1 2 3 4 5 6 7 8 9))
 
 ;;; bug 313: source transforms were "lisp-1"
 (defun srctran-lisp1-1 (cadr) (if (functionp cadr) (funcall cadr 1) nil))
 (assert (eql (funcall (eval #'srctran-lisp1-1) #'identity) 1))
-(without-package-locks 
+(without-package-locks
    ;; this be a nasal demon, but test anyways
    (defvar caar))
 (defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1))
@@ -442,5 +442,51 @@
        (compiled-res (funcall (compile nil form)))
        (real-res (- 1 (aref (funcall (eval #'bit-not) v) 0))))
   (assert (equal compiled-res real-res)))
-
-(sb-ext:quit :unix-status 104)
+
+;; bug reported on sbcl-devel by Hannu Koivisto on 2005-08-10
+(defvar *hannu-trap* nil)
+(progv '(*hannu-trap*) '()
+  (setq *hannu-trap* t))
+(assert (not *hannu-trap*))
+
+;;; bug reported on sbcl-help by Vasile Rotaru
+(let* ((initial-size (expt 2 16))
+       (prime-table (make-array initial-size
+                                :element-type 'integer))
+       (first-primes #(5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71
+       73
+                      79 83 89 97 101 103 107 109 113 127 131 137 139 149
+                      151 157 163 167 173 179 181 191 193 197 199 211 223
+                      227 229 233 239 241 251 257 263 269 271 277 281))
+       (count 0)
+       (increment 2))
+
+  (defun largest-prime-so-far ()
+    (aref prime-table (1- count)))
+  (defun add-prime (prime)
+    (setf (aref prime-table count) prime) (incf count))
+  (defun init-table ()
+    (map 'nil #'add-prime first-primes))
+  (defun next-candidate (candidate)
+    (prog1 (+ candidate increment)
+      (ecase increment
+        (2 (setf increment 4))
+        (4 (setf increment 2)))))
+  (defun prime-p (n)
+    (let ((sqrt-n (truncate (sqrt n))))
+      (dotimes (i count)
+        (let ((prime (aref prime-table i)))
+          (when (> prime sqrt-n)
+            (return-from prime-p t))
+          (when (zerop (mod n prime))
+            (return-from prime-p nil))))
+      (error "~&prime-table too small: ~A ~A~%" n
+      (largest-prime-so-far))))
+  (defun generate-primes (required)
+    (do ((candidate (next-candidate (largest-prime-so-far))
+                    (next-candidate candidate)))
+        ((> candidate required))
+      (when (prime-p candidate)
+        (add-prime candidate))))
+  ;;
+  (init-table))