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

Use more scratch files

Browse source
This commit is contained in:
Douglas Katzman 2019-03-19 15:47:35 -04:00
parent 5472ca6ed8
commit 9e68e626a8
5 changed files with 11 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
tests/compiler.impure.lisp
View file

@ -1782,20 +1782,18 @@
(coerce result 'string))))) (coerce result 'string)))))
;;; Calling thru constant symbols ;;; Calling thru constant symbols
(require :sb-introspect)
(declaim (inline target-fun)) (declaim (inline target-fun))
(defun target-fun (arg0 arg1) (defun target-fun (arg0 arg1)
(+ arg0 arg1)) (+ arg0 arg1))
(declaim (notinline target-fun)) (declaim (notinline target-fun))
;; FIXME: should use compiler-test-util, not sb-introspect here.
;; That issue aside, neither sb-introspect nor ctu:find-named-callees ;; That issue aside, neither sb-introspect nor ctu:find-named-callees
;; can examine an interpreted function for its callees, ;; can examine an interpreted function for its callees,
;; so we can't actually use this function. ;; so we can't actually use this function.
(defun test-target-fun-called (fun res) (defun test-target-fun-called (fun res)
(assert (member #'target-fun (assert (member #'target-fun
(sb-introspect:find-function-callees #'caller-fun-1))) (ctu:find-named-callees #'caller-fun-1)))
(assert (equal (funcall fun) res))) (assert (equal (funcall fun) res)))
(defun caller-fun-1 () (defun caller-fun-1 ()

12
tests/kill-non-lisp-thread.impure.lisp
View file

@ -28,10 +28,12 @@
output)) output))
output)) output))
(run "/bin/sh" "run-compiler.sh" "-sbcl-pic" "-sbcl-shared" (defvar *delete* nil)
"-O3" "-I" "../src/runtime/" (unless (probe-file "kill-non-lisp-thread.so")
"kill-non-lisp-thread.c" "-o" "kill-non-lisp-thread.so") (run "/bin/sh" "run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
"-O3" "-I" "../src/runtime/"
"kill-non-lisp-thread.c" "-o" "kill-non-lisp-thread.so")
(setq *delete* t))
(load-shared-object (truename "kill-non-lisp-thread.so")) (load-shared-object (truename "kill-non-lisp-thread.so"))
(define-alien-routine kill-non-lisp-thread void) (define-alien-routine kill-non-lisp-thread void)
@ -52,4 +54,4 @@
(sleep 1) (sleep 1)
(assert receivedp))) (assert receivedp)))
(delete-file "kill-non-lisp-thread.so") (when *delete* (delete-file "kill-non-lisp-thread.so"))

1
tests/octets.pure.lisp
View file

@ -410,6 +410,7 @@
(assert (string= (read-line f1) (read-line f2)))))) (assert (string= (read-line f1) (read-line f2))))))
(flet ((compile-and-load (file encoding main-fun) (flet ((compile-and-load (file encoding main-fun)
(let ((fasl (compile-file file (let ((fasl (compile-file file
:output-file (scratch-file-name "fasl")
:external-format encoding :external-format encoding
:print nil :verbose nil))) :print nil :verbose nil)))
(load fasl) (load fasl)

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

@ -25,7 +25,7 @@
;;; The code below tests only UNREAD-CHAR. It would be nice to test ;;; The code below tests only UNREAD-CHAR. It would be nice to test
;;; CLEAR-INPUT too, but I'm not sure how to do it cleanly and ;;; CLEAR-INPUT too, but I'm not sure how to do it cleanly and
;;; portably in a noninteractive test. -- WHN 2001-05-05 ;;; portably in a noninteractive test. -- WHN 2001-05-05
(defparameter *scratch-file-name* "sbcl-wrapped-stream-test-data.tmp") (defparameter *scratch-file-name* (scratch-file-name))
(defvar *scratch-file-stream*) (defvar *scratch-file-stream*)
(dolist (scratch-file-length '(1 ; everyone's favorite corner case (dolist (scratch-file-length '(1 ; everyone's favorite corner case
200123)) ; hopefully much bigger than buffer 200123)) ; hopefully much bigger than buffer

2
tests/stream.pure.lisp
View file

@ -360,7 +360,7 @@
;;; buffer-fill routine is responsible for figuring out when we've ;;; buffer-fill routine is responsible for figuring out when we've
;;; reached EOF. ;;; reached EOF.
(with-test (:name (stream :listen-vs-select) :fails-on :win32) (with-test (:name (stream :listen-vs-select) :fails-on :win32)
(let ((listen-testfile-name "stream.impure.lisp.testqfile") (let ((listen-testfile-name (scratch-file-name))
;; If non-NIL, size (in bytes) of the file that will exercise ;; If non-NIL, size (in bytes) of the file that will exercise
;; the LISTEN problem. ;; the LISTEN problem.
(bytes-per-buffer-sometime (bytes-per-buffer-sometime