From: Juho S. <js...@us...> - 2006-01-26 23:06:30
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23166/tests Modified Files: bit-vector.impure-cload.lisp debug.impure.lisp external-format.impure.lisp float.pure.lisp Log Message: 0.9.9.2: Test cleanups. * Mark some tests as expected to fail on various platforms, based on information from test reports on sbcl-devel * Disable the failing external-format test completely, since it was sometimes failing in unexpected ways due to WITH-TIMEOUT races * Try to avoid running TEST-BIG-BIT-VECTORS on platforms where the big vector doesn't fit into the dynamic space Index: bit-vector.impure-cload.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/bit-vector.impure-cload.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- bit-vector.impure-cload.lisp 28 Aug 2005 02:26:45 -0000 1.7 +++ bit-vector.impure-cload.lisp 26 Jan 2006 23:06:06 -0000 1.8 @@ -78,7 +78,17 @@ (test-small-bit-vectors) -#-x86-64 -;; except on machines where addressable space is likely to be -;; much bigger than physical memory +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun dynamic-space-size () + #+gencgc + (- sb-vm:dynamic-space-end sb-vm:dynamic-space-start) + #-gencgc + (- sb-vm:dynamic-space-0-end sb-vm:dynamic-space-0-start))) + +;; except on machines where the arrays won't fit into the dynamic space. +#+#.(cl:if (cl:> (cl-user::dynamic-space-size) + (cl:truncate (cl:1- cl:array-dimension-limit) + sb-vm:n-word-bits)) + '(and) + '(or)) (test-big-bit-vectors) Index: debug.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/debug.impure.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- debug.impure.lisp 6 Oct 2005 15:31:37 -0000 1.24 +++ debug.impure.lisp 26 Jan 2006 23:06:06 -0000 1.25 @@ -190,7 +190,7 @@ (list '(flet test) #'not-optimized)))))) (with-test (:name (:throw :no-such-tag) - :fails-on '(or (and :x86 :linux) :alpha :mips)) + :fails-on '(or (and :x86 :linux) (and :x86 :freebsd) :alpha :mips)) (progn (defun throw-test () (throw 'no-such-tag t)) @@ -349,12 +349,14 @@ ;;; suspicions that the breakpoint trace might corrupt the whole image ;;; on that platform. #-(and ppc darwin) -(let ((out (with-output-to-string (*trace-output*) - (trace trace-this :encapsulate nil) - (assert (eq 'ok (trace-this))) - (untrace)))) - (assert (search "TRACE-THIS" out)) - (assert (search "returned OK" out))) +(with-test (:name (trace :encapsulate nil) + :fails-on '(or ppc sparc)) + (let ((out (with-output-to-string (*trace-output*) + (trace trace-this :encapsulate nil) + (assert (eq 'ok (trace-this))) + (untrace)))) + (assert (search "TRACE-THIS" out)) + (assert (search "returned OK" out)))) ;;;; test infinite error protection Index: external-format.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/external-format.impure.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- external-format.impure.lisp 29 Nov 2005 13:34:35 -0000 1.9 +++ external-format.impure.lisp 26 Jan 2006 23:06:06 -0000 1.10 @@ -117,8 +117,15 @@ (dotimes (i 80) (assert (equal (read-line s nil s) "1234567890123456789012345678901234567890123456789"))))))) + (with-test (:name (:character-decode-large :force-end-of-file) :fails-on :sbcl) + (error "We can't reliably test this due to WITH-TIMEOUT race condition") + ;; This test will currently fail. But sometimes it will fail in + ;; ungracefully due to the WITH-TIMEOUT race mentioned above. This + ;; rightfully confuses some people, so we'll skip running the code + ;; for now. -- JES, 2006-01-27 + #+nil (with-open-file (s "external-format-test.txt" :direction :input :external-format :utf-8) (handler-bind Index: float.pure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/float.pure.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- float.pure.lisp 15 Oct 2005 19:40:32 -0000 1.25 +++ float.pure.lisp 26 Jan 2006 23:06:06 -0000 1.26 @@ -93,7 +93,7 @@ (assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum)))) (with-test (:name (:scale-float-overflow :bug-372) - :fails-on '(or :ppc)) ;; bug 372 + :fails-on '(or :ppc :freebsd)) ;; bug 372 (progn (assert (raises-error? (scale-float 1.0 most-positive-fixnum) floating-point-overflow)) @@ -119,7 +119,7 @@ 'double-float)) (with-test (:name (:addition-overflow :bug-372) - :fails-on '(or :ppc :mips)) + :fails-on '(or :ppc :mips :freebsd)) (assert (typep (nth-value 1 (ignore-errors |