blob: d39fff8311061acfd1224a898e2a50a2acb24c40 (
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
#!/bin/sh
logdir=/var/tmp/sbcl-test-logs-$$
echo ==== Writing logs to $logdir ====
mkdir -p /var/tmp/junk $logdir
TEST_DIRECTORY=/var/tmp/junk SBCL_HOME=../obj/sbcl-home exec ../src/runtime/sbcl \
--noinform --core ../output/sbcl.core --no-userinit --no-sysinit --noprint --disable-debugger << EOF
(require :sb-posix)
(let ((*evaluator-mode* :compile))
(with-compilation-unit () (load"run-tests")))
(in-package run-tests)
(import '(sb-alien:alien-funcall sb-alien:extern-alien
sb-alien:int sb-alien:c-string sb-alien:unsigned))
(setq *summarize-test-times* t)
(defun parallel-execute-tests (max-jobs)
(format t "Using ~D processes~%" max-jobs)
;; Interleave the order in which all tests are launched rather than
;; starting them in the batches that filtering places them in.
(let ((files (sort (mapcar #'pathname-name
(append (pure-load-files)
(pure-cload-files)
(impure-load-files)
(impure-cload-files)
(sh-files)))
#'string<))
(subprocess-count 0)
(subprocess-list nil)
(aggregate-vop-usage (make-hash-table))
(missing-usage)
(losing))
(labels ((wait ()
(multiple-value-bind (pid status) (sb-posix:wait)
(decf subprocess-count)
(let ((process (assoc pid subprocess-list)))
(setq subprocess-list (delete process subprocess-list))
(let* ((code (ash status -8))
(filename (cdr process)))
(unless (sum-vop-usage (format nil "$logdir/~a.vop-usage" filename) t)
(when (or (search ".pure" filename) (search ".impure" filename))
(push filename missing-usage)))
(cond ((eq code 104)
(format t "~A: success~%" filename))
(t
(format t "~A: status ~D~%" filename code)
(push filename losing)))))))
(sum-vop-usage (input deletep)
(with-open-file (f input :if-does-not-exist nil)
;; No vop coverage file from shell script tests or any test
;; that internally uses (EXIT) for whatever reason.
(when f
(loop (let ((line (read-line f nil)))
(unless line (return))
(let ((count (read-from-string line))
(name (read-from-string line t nil :start 8)))
(incf (gethash name aggregate-vop-usage 0) count))))
(when deletep (delete-file f))))))
(dolist (file files)
(when (>= subprocess-count max-jobs)
(wait))
(let ((pid (sb-posix:fork)))
(when (zerop pid)
(with-open-file (stream (format nil "$logdir/~a" file)
:direction :output :if-exists :supersede)
(alien-funcall (extern-alien "dup2" (function int int int))
(sb-sys:fd-stream-fd stream) 1)
(alien-funcall (extern-alien "dup2" (function int int int)) 1 2))
;; Send this to the log file, not the terminal
(setq *debug-io* (make-two-way-stream (make-concatenated-stream)
*error-output*))
(cond ((string= (pathname-type file) "test")
;; exec /bin/sh with the test and we'll pick up its exit code
(alien-funcall (extern-alien "execl" (function int c-string c-string
c-string unsigned))
"/bin/sh" "/bin/sh"
(concatenate 'string file ".sh") 0)
;; if exec fails, just exit with a wrong (not 104) status
(alien-funcall (extern-alien "_exit" (function (values) int)) 0))
(t
(setq sb-c::*static-vop-usage-counts* (make-hash-table))
(let ((*features* (cons :parallel-test-runner *features*)))
(pure-runner (list (concatenate 'string file ".lisp"))
(if (search "-cload" file) 'cload-test 'load-test)
(make-broadcast-stream)))
(with-open-file (output (format nil "$logdir/~a.vop-usage" file)
:direction :output)
(sb-int:dohash ((name count) sb-c::*static-vop-usage-counts*)
(format output "~7d ~s~%" count name)))
(exit :code (if (unexpected-failures) 1 104)))))
(format t "~A: pid ~d~%" file pid)
(incf subprocess-count)
(push (cons pid file) subprocess-list)))
(loop (if (plusp subprocess-count) (wait) (return)))
(dolist (result '("vop-usage.txt" "vop-usage-combined.txt"))
(let (list)
(sb-int:dohash ((name vop) sb-c::*backend-template-names*)
(declare (ignore vop))
(push (cons (gethash name aggregate-vop-usage 0) name) list))
(with-open-file (output (format nil "$logdir/~a" result)
:direction :output
:if-exists :supersede)
(dolist (cell (sort list #'> :key #'car))
(format output "~7d ~s~%" (car cell) (cdr cell)))))
(sum-vop-usage "../output/warm-vop-usage.txt" nil))
(when missing-usage
(format t "~&Missing vop-usage:~{ ~a~}~%" missing-usage))
(when losing
(format t "~&Failing files:~%")
(dolist (filename losing)
(format t "~A~%" filename))
(exit :code 1)))))
(parallel-execute-tests $1)
EOF
|
