X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure-cload.lisp;h=a6736013e67a832bc290c2eb933bf615587192a5;hb=1aee76da48edafa210f60e852913041a843428b7;hp=7d5e99d1d483260777411c95cd293868dcc18c66;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index 7d5e99d..a673601 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -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))