common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Stop writing large files in a test

Browse source 
What's /dev/null for
This commit is contained in:
Stas Boukarev 2026-02-25 14:56:41 +03:00
parent ebc6171e70
commit d4c5c24450
10 changed files with 36 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
tests/arith-2.pure.lisp
View file

@ -872,7 +872,7 @@
(values (the (signed-byte 25) (ceiling x 2))))))))
(with-test (:name :word-floor-ceiling
:fails-on (or :ppc :arm :riscv :loongarch64 :mips :sparc))
:fails-on (or :ppc :arm :riscv :loongarch64 :sparc))
(assert (not (ctu:ir1-named-calls `(lambda (x y)
(declare (sb-vm:signed-word x y))
(floor x y)))))
@ -1954,7 +1954,7 @@
((1) 29953653503380140693)))
(with-test (:name :logand-cut-constants.2
:fails-on (or :arm :ppc :sparc))
:fails-on (or :arm :mips :ppc :sparc))
(assert (= (count-if (lambda (c)
(member c '(logand sb-kernel:two-arg-and)))
(ctu:ir1-named-calls `(lambda (n m)

6
tests/compiler-2.pure.lisp
View file

@ -2459,7 +2459,8 @@
(f count))))))
((1) nil)))
(with-test (:name (:mv-call :more-arg))
(with-test (:name (:mv-call :more-arg)
:fails-on :mips)
(checked-compile-and-assert
()
'(lambda (&rest rest)
@ -2468,7 +2469,8 @@
(list a b)))
((1 3) '(1 3) :test #'equal)))
(with-test (:name (:mv-call :more-arg-unused))
(with-test (:name (:mv-call :more-arg-unused)
:fails-on :mips)
(checked-compile-and-assert
()
'(lambda (&rest rest)

4
tests/compiler.pure.lisp
View file

@ -5457,7 +5457,7 @@
(with-test (:name (oddp bignum :no-consing)
:serial t
:skipped-on :interpreter
:fails-on (or :arm :ppc :ppc64 :riscv :loongarch64 :sparc))
:fails-on (or :arm :ppc :ppc64 :riscv :loongarch64 :sparc :mips))
(let ((f (checked-compile '(lambda (x) (oddp x))))
(x (* most-positive-fixnum most-positive-fixnum 3)))
(ctu:assert-no-consing (funcall f x))))
@ -5468,7 +5468,7 @@
(with-test (:name (logtest bignum :no-consing)
:serial
t :skipped-on :interpreter
:fails-on (or :arm :ppc :ppc64 :riscv :loongarch64 :sparc))
:fails-on (or :arm :ppc :ppc64 :riscv :loongarch64 :sparc :mips))
(let ((f (checked-compile '(lambda (x) (logtest x 1))))
(x (* most-positive-fixnum most-positive-fixnum 3)))
(ctu:assert-no-consing (funcall f x))))

2
tests/disassem.pure-cload.lisp
View file

@ -11,7 +11,7 @@
(print 20)))
(with-test (:name :disassemble-annotate-funs
:fails-on (or :ppc :sparc))
:fails-on (or :ppc :sparc :mips))
(let ((dis (with-output-to-string (str) (disassemble #'disassemble-annotate-funs :use-labels nil :stream str))))
(assert (search "PRINC" dis))
(assert (search "PRINT" dis))

2
tests/float-2.pure.lisp
View file

@ -901,7 +901,7 @@ fractional bits."
(ffloor x 1d0))))))
(with-test (:name :the-truncate
:fails-on :loongarch64)
:fails-on (or :mips :loongarch64))
(checked-compile-and-assert
(:optimize :safe-debug)
`(lambda (n)

3
tests/foreign-stack-alignment.impure.lisp
View file

@ -68,7 +68,8 @@
(assert (= *good-offset* (stack-alignment-offset *required-alignment*))))
#+alien-callbacks
(with-test (:name :callback)
(with-test (:name :callback
:broken-on :mips)
(assert (= *good-offset*
(with-alien-callable ((callback int ()
(stack-alignment-offset *required-alignment*)))

4
tests/hash.pure.lisp
View file

@ -411,7 +411,7 @@
(with-test (:name :array-psxhash-non-consing
:skipped-on :interpreter
:fails-on (or :ppc64 :sparc))
:fails-on (or :ppc64 :mips :sparc))
(let ((a (make-array 1000 :element-type 'double-float
:initial-element (+ 0d0 #+(or arm64 x86-64)
1d300))))
@ -514,7 +514,7 @@
(murmur-compare (make-random-state t) 100000))
(with-test (:name :sap-hash
:fails-on :sparc)
:fails-on (or :mips :sparc))
(assert (/= (sxhash (sb-sys:int-sap #x1000))
(sxhash (sb-sys:int-sap 0))))
#-interpreter

2
tests/pathnames.pure.lisp
View file

@ -959,7 +959,7 @@
#P"a/b/srcfile.fasl"))))
(with-test (:name :intern-pathname-non-consy
:fails-on :sparc
:fails-on (or :mips :sparc)
:skipped-on :interpreter)
(ctu:assert-no-consing (make-pathname :name "hi" :type "txt")))

4
tests/reader.pure.lisp
View file

@ -383,7 +383,7 @@
(compile 'test-reader-consing)
(with-test (:name :read-does-not-cons-per-se
:fails-on :sparc)
:fails-on (or :mips :sparc))
;; These each used to produce at least 20 MB of garbage,
;; a result of using 128-character (= 512 bytes for Unicode) buffers.
;; Now we use exactly one buffer, or maybe two for package + symbol-name.
@ -403,7 +403,7 @@
;; *READ-SUPPRESS* avoids creation of lists
(test-reader-consing "#-sbcl(a (b c (d (e) (f) g)) h i j . x . y baz) 5"))
(with-test (:name :read-symbol-does-not-cons-per-se
:fails-on (or :arm :ppc :sparc)) ; no idea why. does it vary by #+/-sb-thread?
:fails-on (or :mips :arm :ppc :sparc)) ; no idea why. does it vary by #+/-sb-thread?
(test-reader-consing "COMMON-LISP-USER::A-SYMBOL"))
(when (let ((s (find-symbol "ALLOCATE-VECTOR-ON-NUMBER-STACK" "SB-VM")))
(and s (gethash s sb-c::*backend-parsed-vops*)))

45
tests/stream.impure.lisp
View file

@ -475,32 +475,25 @@
(delete-file pathname)))
;;; writing looong lines. takes way too long and way too much space
;;; to test on 64 bit platforms
(with-test (:name (:write-char :long-lines :stream-ouput-column)
:skipped-on :64-bit)
(let ((test (scratch-file-name)))
(unwind-protect
(with-open-file (f test
:direction :output
:external-format :ascii
:element-type 'character
:if-does-not-exist :create
:if-exists :supersede)
(let* ((n (truncate most-positive-fixnum 16))
(m 18)
(p (* n m))
(buffer (make-string n)))
(dotimes (i m)
(write-char #\.)
(finish-output)
(write-sequence buffer f))
(assert (= p (sb-impl::fd-stream-output-column f)))
(write-char #\! f)
(assert (= (+ 1 p) (sb-impl::fd-stream-output-column f)))
(assert (typep p 'bignum))))
(when (probe-file test)
(delete-file test)))))
(with-test (:name (:write-char :long-lines :stream-ouput-column))
(with-open-file (f (or #+win32 "nul" "/dev/null")
:direction :output
:external-format :ascii
:element-type 'character
:if-exists :append)
(let* ((n 33554431)
(m 17)
(p (* n m))
(buffer (make-string n :element-type 'base-char)))
(dotimes (i m)
(write-char #\.)
(finish-output)
(write-sequence buffer f))
(assert (= p (sb-impl::fd-stream-output-column f)))
(write-char #\! f)
(assert (= (+ 1 p) (sb-impl::fd-stream-output-column f)))
#-64-bit
(assert (typep p 'bignum)))))
;;; read-sequence misreported the amount read and lost position
(with-test (:name (read-sequence :read-elements))