blob: 7a1821c8e5f7011fa4d61a60b4fe18130dfff92a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
#!/bin/sh
mkdir -p /var/tmp/junk
TEST_DIRECTORY=/var/tmp/junk SBCL_HOME=../obj/sbcl-home exec ../src/runtime/sbcl \
--noinform --core ../output/sbcl.core --noprint << EOF
(require :sb-posix)
(let ((*evaluator-mode* :compile))
(with-compilation-unit () (load"run-tests")))
(in-package run-tests)
(setq *summarize-test-times* t)
(defun parallel-execute-tests (max-jobs)
(format t "Using ~D processes~%" max-jobs)
(let ((files (mapcar #'pathname-name
(append (pure-load-files)
(pure-cload-files)
(impure-load-files)
(impure-cload-files))))
(subprocess-count 0)
(subprocess-list nil)
(lose))
;; Pull threads.* to the front since they take so long
(let ((fixed '("threads.impure" "threads.pure")))
(setq files
(append fixed
(delete-if (lambda (x) (member x fixed :test 'string=))
files))))
(fresh-line)
(flet ((wait ()
(decf subprocess-count)
(multiple-value-bind (pid status) (sb-posix:wait)
(let ((process (assoc pid subprocess-list)))
(setq subprocess-list (delete process subprocess-list))
(let ((code (ash status -8)))
(format t "~S: status ~D~%" (cdr process) code)
(unless (= code 104)
(setq lose t)))))))
(dolist (file files)
(when (>= subprocess-count max-jobs)
(wait))
(let ((pid (sb-posix:fork)))
(when (zerop pid)
(with-open-file (stream (format nil "/var/tmp/sbcl-test-logs/~a" file)
:direction :output :if-exists :supersede)
sb-alien::(alien-funcall (extern-alien "dup2" (function int int int))
(sb-sys:fd-stream-fd stream) 1)
sb-alien::(alien-funcall (extern-alien "dup2" (function int int int)) 1 2))
(pure-runner (list (concatenate 'string file ".lisp"))
(if (search "-cload" file) 'cload-test 'load-test)
(make-broadcast-stream))
(exit :code (if (unexpected-failures) 1 104)))
(format t "~S: started pid ~d~%" file pid)
(incf subprocess-count)
(push (cons pid file) subprocess-list)))
(loop (if (plusp subprocess-count) (wait) (return)))
(if lose (exit :code 1)))))
(parallel-execute-tests $1)
EOF
|
