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

Spell things.

Browse source
This commit is contained in:
Stas Boukarev 2023-11-30 00:13:42 +03:00
parent f07a4bdb04
commit 5dd9e7af5c
19 changed files with 76 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
contrib/sb-concurrency/tests/test-gate.lisp
View file

@ -11,6 +11,7 @@
(in-package :sb-concurrency-test)
#-gc-stress
(deftest gate.0
(let ((gate (make-gate :open t)))
(values (wait-on-gate gate)
@ -136,6 +137,7 @@
(values (join-thread waiter) cancel))
t t)
#-gc-stress
(deftest gate-timeout.1
(let* ((gate (make-gate))
(waiter (make-thread (lambda ()
@ -143,6 +145,7 @@
(join-thread waiter))
nil)
#-gc-stress
(deftest gate-timeout.2
(let* ((gate (make-gate))
(waiter (make-thread (lambda ()

3
contrib/sb-introspect/test-driver.lisp
View file

@ -449,7 +449,8 @@
(defun get-small-bignum-allocation-information ()
(setq *small-bignum* (+ (+ *b* (ash 1 100)) *negb*))
(nth-value 1 (allocation-information *small-bignum*)))
#-mark-region-gc
#-(or mark-region-gc gc-stress)
(deftest allocation-information.7
(locally
(declare (notinline format))

4
contrib/sb-posix/posix-tests.lisp
View file

@ -419,7 +419,7 @@
sb-posix::o-nonblock))
t)
#-(or win32 netbsd) ; fix: cant handle c-vargs
#-(or gc-stress win32 netbsd) ; fix: cant handle c-vargs
(deftest fcntl.flock.1
(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
(let ((flock (make-instance 'sb-posix:flock
@ -454,7 +454,7 @@
42)
#-(or win32 netbsd)
#-(or gc-stress win32 netbsd)
(deftest fcntl.flock.2
(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
(let ((flock (make-instance 'sb-posix:flock

3
tests/bug-936304.impure.lisp
View file

@ -14,7 +14,8 @@
(setf (elt x 0) t)
(elt x 0)))
(with-test (:name :bug-936304)
(with-test (:name :bug-936304
:skipped-on :gc-stress)
(gc :full t)
(assert (eq :ok (handler-case
(progn

8
tests/deadline.impure.lisp
View file

@ -94,7 +94,8 @@
(assert (not final))))
(with-test (:name (:deadline sb-thread:grab-mutex)
:skipped-on (not :sb-thread))
:skipped-on (not :sb-thread)
:broken-on (and :gc-stress :darwin))
(assert-timeout ("A deadline was reached after 1 second.")
(let ((lock (sb-thread:make-mutex))
(waitp t))
@ -123,7 +124,7 @@
(with-test (:name (:deadline :futex-wait-eintr)
:skipped-on (not :sb-thread)
:broken-on :win32)
:broken-on (or :win32 (and :darwin :gc-stress)))
(let ((lock (sb-thread:make-mutex))
(waitp t))
(make-join-thread (lambda ()
@ -392,7 +393,8 @@
B-result))))))
;;; Test from git rev 5e55f426de8fa579a0d6cfbfb3ac5433d530d3c9 formerly in threads.impure
(test-util:with-test (:name (:deadline :interrupts-enabled) :skipped-on (:not :sb-thread))
(test-util:with-test (:name (:deadline :interrupts-enabled) :skipped-on (:not :sb-thread)
:fails-on :gc-stress)
;; I cranked this up to 1000 (and ran it on lots of machines) to get examples of failure,
;; but that's more than a reasonable amount of time to spend in the test.
(loop repeat 2 do (signal-dealine-check-interrupt-enablement)))

3
tests/deadlock.impure.lisp
View file

@ -75,7 +75,8 @@
(assert (stringp err)))
(assert (eq :ok (join-thread t1)))))
(with-test (:name :deadlock-detection.3)
(with-test (:name :deadlock-detection.3
:broken-on (and :darwin :gc-stress))
(let* ((m1 (make-mutex :name "M1"))
(m2 (make-mutex :name "M2"))
(s1 (make-semaphore :name "S1"))

23
tests/defstruct.impure.lisp
View file

@ -570,17 +570,22 @@
(terpri s)
(write-string "(defun dumped-huge-manyraw () '#.(make-huge-manyraw))" s)
(write-string "(defun dumped-hugest-manyraw () '#.(make-hugest-manyraw))" s))
(defvar *tempfasl* (compile-file *tempfile*))
(delete-file *tempfile*)
(defvar *tempfasl*)
(with-test (:name :compile-huge-manyraw
:skipped-on :gc-stress)
(setf *tempfasl* (compile-file *tempfile*))
(delete-file *tempfile*)
;;; nuke the objects and try another GC just to be extra careful
(setf *manyraw* nil)
(sb-ext:gc :full t)
;; nuke the objects and try another GC just to be extra careful
(setf *manyraw* nil)
(sb-ext:gc :full t)
;;; re-read the dumped structures and check them
(load *tempfasl*)
(delete-file *tempfasl*)
(with-test (:name (:defstruct-raw-slot load))
;; re-read the dumped structures and check them
(load *tempfasl*)
(delete-file *tempfasl*))
(with-test (:name (:defstruct-raw-slot load)
:skipped-on :gc-stress)
(check-manyraws (dumped-manyraws))
(check-huge-manyraw (make-huge-manyraw))
(assert (equalp (make-huge-manyraw) (dumped-huge-manyraw)))

2
tests/exit-hang.impure.lisp
View file

@ -28,7 +28,7 @@
`("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
"-o" ,solib "fcb-threads.c"))
(sb-alien:load-shared-object solib)))
#+(and linux gc-stress) (invoke-restart 'run-tests::skip-file)
;;; Final test: EXIT does not lock up due to (simulated) C++ destructors
;;; or free() or most anything else involved in stopping the main thread.
;;; The point of the test is to mock a Lisp thread that uses foreign code

16
tests/gc.impure.lisp
View file

@ -45,7 +45,7 @@
;; Assert something about *CURRENT-THREAD* seeing objects that it just consed.
(with-test (:name :m-a-o-threadlocally-precise
:skipped-on (:or (:not :sb-thread) :interpreter))
:skipped-on (:or (:not :sb-thread) :interpreter :gc-stress))
(let ((before (make-array 4))
(after (make-array 4 :initial-element 0)))
(flet ((countit (obj type size)
@ -91,6 +91,7 @@
;;; (I don't know what platforms it passes on, but at least these two it does)
(with-test (:name :repeatably-count-allocated-objects
:skipped-on (or (not (or :x86 :x86-64))
:gc-stress
:interpreter))
(let ((a (make-array 5)))
(dotimes (i (length a))
@ -133,7 +134,7 @@
(sb-kernel:get-lisp-obj-address string-one)
(sb-kernel:get-lisp-obj-address string-two)))))
(with-test (:name :pin-all-code-with-gc-enabled
:skipped-on :interpreter)
:skipped-on (or :interpreter :gc-stress))
(gc)
#+sb-thread (sb-thread:join-thread (sb-thread:make-thread #'make-some-objects))
#-sb-thread (progn (make-some-objects) (sb-sys:scrub-control-stack))
@ -445,7 +446,8 @@
(values n tot-bytes))))
(compile 'code-iterator)
(with-test (:name :code-iteration-fast)
(with-test (:name :code-iteration-fast
:skipped-on :gc-stress)
(sb-int:binding* (((slow-n slow-bytes) (code-iterator :slow))
((fast-n fast-bytes) (code-iterator :fast)))
;; Fast should be 20x to 50x faster than slow, but that's kinda sensitive
@ -454,8 +456,9 @@
(assert (= slow-bytes fast-bytes)))))
(defglobal *wp-for-signal-handler-gc-test* nil)
#+(and generational unix sb-thread)
(with-test (:name :signal-handler-gc-test)
(with-test (:name :signal-handler-gc-test
:skipped-on (not (and :generational :unix :sb-thread))
:broken-on (and :arm64 :gc-stress))
(sb-thread:join-thread
(sb-thread:make-thread
(lambda ()
@ -476,7 +479,8 @@
(/ sb-vm:large-object-size sb-vm:n-word-bytes)))
(gc)
(with-test (:name :page-protected-p :broken-on :x86
:fails-on (and :big-endian :ppc64))
:fails-on (and :big-endian :ppc64)
:skipped-on :gc-stress)
(if (= (sb-kernel:generation-of *vvv*) 0) (gc))
(assert (= (sb-kernel:generation-of *vvv*) 1))
(assert (sb-kernel:page-protected-p *vvv*))

1
tests/icf-smoketest.impure-cload.lisp
View file

@ -4,4 +4,5 @@
(eval '(defun hhh () 92))
;;; Ensure no crash on (FIND-PACKAGE (SYMBOL-PACKAGE NIL)) if two functions
;;; are identical and one is named by an uninterned symbol.
#-(and gc-stress arm64)
(fold-identical-code :aggressive t)

2
tests/immobile-space.impure.lisp
View file

@ -1,5 +1,5 @@
#-immobile-space (invoke-restart 'run-tests::skip-file)
#+(or (not immobile-space) gc-stress) (invoke-restart 'run-tests::skip-file)
;;; If an instance was allocated but its layout not stored yet
;;; it could crash

20
tests/run-tests.lisp
View file

@ -68,13 +68,17 @@
(impure-cload (impure-cload-files))
(sh (sh-files)))
(when skip-to
(flet ((skip (files)
(member skip-to files :key #'file-namestring :test #'equal)))
(or (setf pure-load (skip pure-load))
(setf pure-cload (skip pure-cload))
(setf impure-load (skip impure-load))
(setf impure-cload (skip impure-cload))
(setf sh (skip sh)))))
(cond ((equal skip-to "impure")
(setf pure-load nil
pure-cload nil))
(t
(flet ((skip (files)
(member skip-to files :key #'file-namestring :test #'equal)))
(or (setf pure-load (skip pure-load))
(setf pure-cload (skip pure-cload))
(setf impure-load (skip impure-load))
(setf impure-cload (skip impure-cload))
(setf sh (skip sh)))))))
(pure-runner pure-load 'load-test log)
(pure-runner pure-cload 'cload-test log)
(impure-runner impure-load 'load-test log)
@ -537,7 +541,7 @@
"--no-userinit"
"--noprint"
"--disable-debugger"
#+gc-sress "--eval" #+gc-sress "(push :gc-stress *features*)"
#+gc-stress "--eval" #+gc-stress "(push :gc-stress *features*)"
"--load" load
"--eval" (write-to-string eval
:right-margin 1000))

3
tests/sb-gmp.impure.lisp
View file

@ -1,7 +1,10 @@
#+(and linux gc-stress) (invoke-restart 'run-tests::skip-file)
(handler-case (require :sb-gmp)
(warning (c)
(when (search "GMP not loaded" (princ-to-string c))
(invoke-restart 'run-tests::skip-file))))
;; FIXME: do we also want to load sb-gmp/tests-stress.lisp?
;; Those tests are wicked slow, taking about 47 seconds on my computer
(load "../contrib/sb-gmp/tests.lisp")

2
tests/sb-mpfr.impure.lisp
View file

@ -1,3 +1,5 @@
#+(and linux gc-stress) (invoke-restart 'run-tests::skip-file)
(handler-case (require :sb-mpfr)
(warning (c)
(when (or (search "requires at least MPFR vers" (princ-to-string c))

3
tests/sb-simd.impure.lisp
View file

@ -4,8 +4,7 @@
;;; RESULT-0 = #<SIMD-PACK 33554433 127 8191 2097153>,
;;; OUTPUT-0 = #<SIMD-PACK 3 8193 2303 1073741823>.
;;; maybe there are other problems but I didn't investigate further.
#+interpreter (invoke-restart 'run-tests::skip-file)
#+(or interpreter gc-stress) (invoke-restart 'run-tests::skip-file)
(handler-case (require :sb-simd)
(condition (c)

10
tests/smoke.impure.lisp
View file

@ -23,10 +23,12 @@
#-x86-64 undefined-function))
;;; ROOM should run without signalling an error. (bug 247)
(let ((*standard-output* (make-broadcast-stream)))
(room)
(room t)
(room nil))
(with-test (:name :room
:broken-on (and :immobile-space :gc-stress))
(let ((*standard-output* (make-broadcast-stream)))
(room)
(room t)
(room nil)))
;;; COPY-SYMBOL should work without signalling an error, even if the
;;; symbol is unbound.

11
tests/test-util.lisp
View file

@ -1,7 +1,7 @@
#+gc-sress
#+gc-stress
(sb-thread:make-thread (lambda ()
(break)
(loop (gc :full t) (sleep 0.001))))
(loop (gc :full t) (sleep 0.001)))
:name "gc stress")
(defpackage :test-util
(:use :cl :sb-ext)
@ -1064,8 +1064,3 @@
(compile nil
`(lambda () (sb-kernel:%make-funcallable-instance ,n)))))
#+gc-stress
(sb-thread:make-thread (lambda ()
(loop (gc :full t) (sleep 0.001)))
:name "gc stress")

6
tests/threads.impure.lisp
View file

@ -74,7 +74,8 @@
;;;; Now the real tests...
(with-test (:name (with-mutex :timeout))
(with-test (:name (with-mutex :timeout)
:broken-on :gc-stress)
(let ((m (make-mutex)))
(with-mutex (m)
(assert (null (join-thread (make-thread
@ -251,7 +252,8 @@
(with-recursive-lock (m :wait-p nil)
t))))))))
(with-test (:name (with-recursive-lock :timeout))
(with-test (:name (with-recursive-lock :timeout)
:broken-on :gc-stress)
(let ((m (make-mutex)))
(with-mutex (m)
(assert (null (join-thread (make-thread

3
tests/traceroot.impure.lisp
View file

@ -96,7 +96,8 @@
;;; 0 1004CBB93F [ 2] a (simple-vector 1)
;;; 0 1004D28AE7 [ 3] a cons = (A B C ...) ; = (NTHCDR 3 object)
;;; 0 1004D28B17 [ 0] a cons = ("hi" D)
(with-test (:name :traceroot-collapse-lists)
(with-test (:name :traceroot-collapse-lists
:skipped-on :gc-stress)
(let* ((string (with-output-to-string (*standard-output*)
(search-roots *string-hi* :print :verbose)))
(lines (split-string string #\newline)))