X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexhaust.impure.lisp;h=6233f11a11320ca83b0cbf57b9029b025318f8d1;hb=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;hp=1bd6d81ee7df555958eac10cb57339398c2e1071;hpb=f9b9b73110f68ff1d548b2a3295b3d08a2dd923b;p=sbcl.git diff --git a/tests/exhaust.impure.lisp b/tests/exhaust.impure.lisp index 1bd6d81..6233f11 100644 --- a/tests/exhaust.impure.lisp +++ b/tests/exhaust.impure.lisp @@ -38,45 +38,49 @@ ;;; Base-case: detecting exhaustion (with-test (:name (:exhaust :basic) :broken-on '(and :sunos :x86-64)) (assert (eq :exhausted - (handler-case - (recurse) - (storage-condition (c) - (declare (ignore c)) - :exhausted))))) + (handler-case + (recurse) + (storage-condition (c) + (declare (ignore c)) + :exhausted))))) ;;; Check that non-local control transfers restore the stack ;;; exhaustion checking after unwinding -- and that previous test ;;; didn't break it. -(with-test (:name (:exhaust :non-local-control) :broken-on '(and :sunos :x86-64)) +(with-test (:name (:exhaust :non-local-control) + :broken-on '(and :sunos :x86-64) + :skipped-on :win32) (let ((exhaust-count 0) - (recurse-count 0)) + (recurse-count 0)) (tagbody :retry (handler-bind ((storage-condition (lambda (c) - (declare (ignore c)) - (if (= *count* (incf exhaust-count)) - (go :stop) - (go :retry))))) - (incf recurse-count) - (recurse)) + (declare (ignore c)) + (if (= *count* (incf exhaust-count)) + (go :stop) + (go :retry))))) + (incf recurse-count) + (recurse)) :stop) (assert (= exhaust-count recurse-count *count*)))) ;;; Check that we can safely use user-provided restarts to ;;; unwind. -(with-test (:name (:exhaust :restarts) :broken-on '(and :sunos :x86-64)) +(with-test (:name (:exhaust :restarts) + :broken-on '(and :sunos :x86-64) + :skipped-on :win32) (let ((exhaust-count 0) - (recurse-count 0)) + (recurse-count 0)) (block nil (handler-bind ((storage-condition (lambda (c) - (declare (ignore c)) - (if (= *count* (incf exhaust-count)) - (return) - (invoke-restart (find-restart 'ok)))))) - (loop - (with-simple-restart (ok "ok") - (incf recurse-count) - (recurse))))) + (declare (ignore c)) + (if (= *count* (incf exhaust-count)) + (return) + (invoke-restart (find-restart 'ok)))))) + (loop + (with-simple-restart (ok "ok") + (incf recurse-count) + (recurse))))) (assert (= exhaust-count recurse-count *count*)))) (with-test (:name (:exhaust :binding-stack)) @@ -93,7 +97,8 @@ (setq ok t))) (assert ok)))) -(with-test (:name (:exhaust :alien-stack) :skipped-on '(not :c-stack-is-control-stack)) +(with-test (:name (:exhaust :alien-stack) + :skipped-on '(or (not :c-stack-is-control-stack))) (let ((ok nil)) (labels ((exhaust-alien-stack (i) (with-alien ((integer-array (array int 500)))