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

More test bookkeeping

Browse source
This commit is contained in:
Stas Boukarev 2026-02-24 05:37:17 +03:00
parent fa16c4bbc0
commit 3179b0fb41
19 changed files with 70 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
tests/allocator.pure.lisp
View file

@ -78,7 +78,8 @@
;;;
;;; I don't remember what the problem is with PPC.
(with-test (:name :no-list-on-large-object-pages
:skipped-on (:or :mips :ppc :ppc64))
:fails-on :sparc
:skipped-on (:or :mips :ppc :ppc64))
(let* ((fun (checked-compile
'(lambda ()
(macrolet ((expand (n) `(list ,@(loop for i from 1 to n collect i))))

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

@ -616,7 +616,7 @@
(values (integer -255 0) (integer -9 0) &optional)))
(with-test (:name :logbitp-on-integers
:fails-on (or :ppc :ppc64 :arm :riscv :loongarch64))
:fails-on (or :ppc :ppc64 :arm :riscv :loongarch64 :mips :sparc))
(assert (not (ctu:ir1-named-calls `(lambda (x)
(logbitp 20 x))))))
(with-test (:name :bt-negative-bit)
@ -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))
:fails-on (or :ppc :arm :riscv :loongarch64 :mips :sparc))
(assert (not (ctu:ir1-named-calls `(lambda (x y)
(declare (sb-vm:signed-word x y))
(floor x y)))))
@ -1329,7 +1329,7 @@
(integer * 0)))
(with-test (:name :ash-overflow
:fails-on (or :ppc :ppc64))
:fails-on (or :sparc :ppc :ppc64))
(checked-compile-and-assert
()
`(lambda (a)
@ -1953,8 +1953,8 @@
((0) 29953653503380140692)
((1) 29953653503380140693)))
(with-test (:name :logand-cut-constants
:fails-on (or :arm :ppc))
(with-test (:name :logand-cut-constants.2
:fails-on (or :arm :ppc :sparc))
(assert (= (count-if (lambda (c)
(member c '(logand sb-kernel:two-arg-and)))
(ctu:ir1-named-calls `(lambda (n m)
@ -2260,7 +2260,7 @@
((0) nil)))
(with-test (:name :logtest-integer-fixnum
:fails-on (or :arm :ppc64 :ppc :riscv :loongarch64))
:fails-on (or :arm :ppc64 :ppc :riscv :loongarch64 :mips :sparc))
(assert (not (ctu:ir1-named-calls `(lambda (x y)
(declare (integer x)
(fixnum y))

3
tests/arith.pure.lisp
View file

@ -1057,7 +1057,8 @@
((2 2) t)
((3 2) nil)))
(with-test (:name :ash-signed-negation-overflow :fails-on :arm)
(with-test (:name :ash-signed-negation-overflow
:fails-on (or :sparc :arm))
(checked-compile-and-assert
()
`(lambda (a b)

2
tests/array.pure.lisp
View file

@ -605,7 +605,7 @@
(('(or (eql -16) unsigned-byte)) #(0) :test #'equalp)))
(with-test (:name :check-bound-signed-bound-notes
:fails-on (not (or :x86-64 :x86 :arm64 :loongarch64)))
:fails-on (not (or :x86-64 :x86 :arm64 :riscv :loongarch64)))
(checked-compile-and-assert
(:allow-notes nil)
`(lambda (x y)

9
tests/chill.impure.lisp
View file

@ -1,6 +1,7 @@
#+parallel-test-runner (setq run-tests::*allowed-inputs* :any)
(with-test (:name (:chill :loads-quietly))
(with-test (:name (:chill :loads-quietly)
:fails-on sparc)
(handler-bind (#-sb-devel (warning (lambda (c) (error "Caught warning: ~A" c))))
(load "../src/cold/chill.lisp")))
@ -27,7 +28,8 @@
(when (eql o eof)
(return)))))))
(with-test (:name (:chill :read-xc-files))
(with-test (:name (:chill :read-xc-files)
:fails-on sparc)
(flet ((try-replacing (stem this that)
(let ((position (search this stem)))
(when position
@ -44,7 +46,8 @@
stem)))
(read-file name)))))))
(with-test (:name (:chill :read-target-2-files))
(with-test (:name (:chill :read-target-2-files)
:fails-on sparc)
(let ((target-2-stems-lists (cdr *build-order-data*)))
(dolist (stems-list target-2-stems-lists)
(dolist (stem stems-list)

10
tests/chill.test.sh
View file

@ -1,5 +1,15 @@
. ./subr.sh
run_sbcl <<EOF
#+sparc (exit :code 2) ;skip
(exit :code 0)
EOF
status=$?
if [ $status != 0 ]; then # test can't be executed
# we don't have a way to exit shell tests with "inapplicable" as the result
exit $EXIT_TEST_WIN
fi
set -e
# The function SB-C:LOCATION-NUMBER does not get defined for all backends,
# and may get dropped by the tree shaker.

8
tests/compiler.pure.lisp
View file

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

4
tests/constraint.pure.lisp
View file

@ -827,7 +827,7 @@
(with-test (:name :bounds-check-min-length
:fails-on (or :ppc :ppc64 :riscv :loongarch64))
:fails-on (or :ppc :ppc64 :riscv :loongarch64 :sparc :mips))
(assert (= (count 'sb-kernel:%check-bound
(ctu:ir1-named-calls
`(lambda (x v)
@ -1910,7 +1910,7 @@
(integer -6176139011 -222)))
(with-test (:name :ignore-delays
:fails-on (or :arm :riscv :loongarch64 :ppc :ppc64))
:fails-on (or :arm :riscv :loongarch64 :ppc :ppc64 :mips :sparc))
(assert-type
(lambda (x)
(declare (optimize debug))

4
tests/debug.impure.lisp
View file

@ -138,7 +138,7 @@
(declare (ignore f stuff))))))
(defparameter *breakpoint-tracing-expectations*
'(:fails-on (or :arm :riscv :ppc64 :ppc)
'(:fails-on (or :arm :riscv :ppc64 :ppc :sparc :mips)
:broken-on (or :loongarch64 :freebsd)))
;;; bug 379
@ -955,7 +955,7 @@
(with-test (:name (:debugger :list-locations)
;; there's an extra location on arm for some reason.
:fails-on (or :arm :loongarch64 :riscv :ppc :ppc64))
:fails-on (or :arm :loongarch64 :riscv :ppc :ppc64 :sparc :mips))
(test-debugger
"ll #'!
debugger-test-done!"

2
tests/defconst.impure-cload.lisp
View file

@ -12,6 +12,6 @@
;; a symbol globally unbound. Unfortunately I don't see an efficient way to make this test
;; pass on threadless builds without scanning the whole binding stack in %DEFCONSTANT.
(test-util:with-test (:name :defconstant-when-specially-boundp
:fails-on (:not :sb-thread))
:fails-on (:or :riscv (:not :sb-thread)))
(constify-boundp)
(assert (eq (symbol-value 'zook) 93)))

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

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

10
tests/foreign.test.sh
View file

@ -19,6 +19,16 @@ primary_c_source=`pwd`/foreigntest.c
. ./expect.sh
. ./subr.sh
run_sbcl <<EOF
#+sparc (exit :code 2) ;skip
(exit :code 0)
EOF
status=$?
if [ $status != 0 ]; then # test can't be executed
# we don't have a way to exit shell tests with "inapplicable" as the result
exit $EXIT_TEST_WIN
fi
use_test_subdirectory
echo //entering foreign.test.sh

2
tests/gc.impure.lisp
View file

@ -529,7 +529,7 @@
(assert (= (sb-sys:sap-ref-word sap (ash i sb-vm:word-shift)))))))))
(with-test (:name :rospace-strings
:fails-on :darwin-jit)
:fails-on (or :darwin-jit :sparc))
(let ((err (handler-case (setf (char (opaque-identity (symbol-name '*readtable*)) 0) #\*)
(sb-sys:memory-fault-error (c)
(write-to-string c :escape nil)))))

2
tests/hash-table.impure.lisp
View file

@ -225,7 +225,7 @@
(with-locked-hash-table (h) (setf (gethash 'foo h) 1))))
(with-test (:name :hash-table-iterator-no-notes
:fails-on (:or :arm :ppc :ppc64 :loongarch64 :riscv))
:fails-on (:or :arm :ppc :ppc64 :loongarch64 :riscv :sparc :mips))
(let ((f
(checked-compile
'(lambda (h)

8
tests/hash.pure.lisp
View file

@ -409,8 +409,9 @@
;; Also the same issue exists with bit-vectors.
(assert-error (sxhash displaced-string))))
(with-test (:name :array-psxhash-non-consing :skipped-on :interpreter
:fails-on :ppc64)
(with-test (:name :array-psxhash-non-consing
:skipped-on :interpreter
:fails-on (or :ppc64 :sparc))
(let ((a (make-array 1000 :element-type 'double-float
:initial-element (+ 0d0 #+(or arm64 x86-64)
1d300))))
@ -512,7 +513,8 @@
(with-test (:name :mumur-hash-compare)
(murmur-compare (make-random-state t) 100000))
(with-test (:name :sap-hash)
(with-test (:name :sap-hash
:fails-on :sparc)
(assert (/= (sxhash (sb-sys:int-sap #x1000))
(sxhash (sb-sys:int-sap 0))))
#-interpreter

3
tests/interface.pure.lisp
View file

@ -190,7 +190,8 @@
(string2 (disassembly-text '(lambda (y) (car y)))))
(assert (string= string1 string2)))))
(with-test (:name :disassemble-assembly-routine)
(with-test (:name :disassemble-assembly-routine
:fails-on :riscv)
(disassemble sb-fasl:*assembler-routines* :stream (make-broadcast-stream)))
(with-test (:name (sb-ext:assert-version->= :ok))

1
tests/pathnames.pure.lisp
View file

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

12
tests/reader.impure.lisp
View file

@ -379,7 +379,8 @@
(assert-error (read-from-string "#S(NODE :NEXT #(#S(NODE :NEXT NIL)))"))
(assert-error (read-from-string "#S(NODE :NEXT #S(NODE :NEXT 1))")))
(with-test (:name (:sharp=-typed-slot :circular :no-error))
(with-test (:name (:sharp=-typed-slot :circular :no-error)
:fails-on :sparc)
(let ((circ (read-from-string "#1=#S(NODE :NEXT #1#)")))
(assert (eql (node-next circ) circ))))
(with-test (:name (:sharp=-typed-slot :circular error))
@ -398,7 +399,8 @@
(assert-error (read-from-string "#S(NODE :LISTNEXT #(#S(NODE :LISTNEXT NIL)))"))
(assert-error (read-from-string "#S(NODE :LISTNEXT (#S(NODE :LISTNEXT 1)))")))
(with-test (:name (:sharp=-cons-typed-slot :circular :no-error))
(with-test (:name (:sharp=-cons-typed-slot :circular :no-error)
:fails-on :sparc)
(let ((circ (read-from-string "#1=#S(NODE :LISTNEXT (#1#))")))
(assert (eql (car (node-listnext circ)) circ))))
(with-test (:name (:sharp=-cons-typed-slot :circular error))
@ -412,7 +414,8 @@
(assert-error (read-from-string "#S(NODE :CONSCONS 1)"))
(assert-error (read-from-string "#S(NODE :CONSCONS (1))")))
(with-test (:name (:sharp=-cons-typed-cons-slot :circular :no-error))
(with-test (:name (:sharp=-cons-typed-cons-slot :circular :no-error)
:fails-on :sparc)
(let* ((circ (car (read-from-string "#1=(#S(NODE :CONSCONS #1#) . #1#)")))
(conscons (node-conscons circ)))
(assert (eql (car conscons) circ))
@ -446,7 +449,8 @@
(dotimes (i 5)
(assert (eql (aref displacement i) array)))))
(with-test (:name (:sharp= :circular-mismatch))
(with-test (:name (:sharp= :circular-mismatch)
:fails-on :sparc)
(assert-error
(read-from-string "#S(NODE :NEXT (#1=#S(NODE :NEXT #1#)))")
type-error))

5
tests/reader.pure.lisp
View file

@ -382,7 +382,8 @@
(read-from-string string)))
(compile 'test-reader-consing)
(with-test (:name :read-does-not-cons-per-se)
(with-test (:name :read-does-not-cons-per-se
:fails-on :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.
@ -402,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)) ; no idea why. does it vary by #+/-sb-thread?
:fails-on (or :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*)))