-
Notifications
You must be signed in to change notification settings - Fork 5
/
utils.lisp
45 lines (40 loc) · 1.77 KB
/
utils.lisp
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
(uiop:define-package :ci-utils/utils
(:use :cl)
(:export #:quickload #:with-fail-on-errors #:without-asdf-bad-system))
(in-package :ci-utils/utils)
(defmacro with-fail-on-errors ((&key (code 123)) &body body)
"print a stack trace and then exit with CODE when BODY signals
any error"
`(handler-bind ((error (lambda (&optional e)
(format t "caught error:~%")
;; make sure we exit properly even if
;; errors or backtrace can't be printed
(ignore-errors (format t " ~a~%" e))
(ignore-errors (format t " ~s~%" e))
(ignore-errors
(uiop:print-condition-backtrace
e :stream *standard-output*))
(finish-output)
(uiop:quit ,code))))
(progn ,@body)))
(defmacro without-asdf-bad-system (() &body body)
"run BODY, with ASDF:BAD-SYSTEM-NAME condition muffled if it exists"
`(handler-bind (#+asdf3.2 (asdf:bad-SYSTEM-NAME
(function MUFFLE-WARNING)))
(progn ,@body)))
(defun quickload (systems &rest keys
&key (fail-on-error t) (ignore-bad-systems t)
&allow-other-keys)
(remf keys :fail-on-error)
(remf keys :ignore-bad-systems)
(flet ((ibs ()
(if ignore-bad-systems
(without-asdf-bad-system ()
(apply #'ql:quickload systems keys))
(apply #'ql:quickload systems keys))))
(if fail-on-error
(with-fail-on-errors (:code (if (numberp fail-on-error)
fail-on-error
123))
(ibs))
(ibs))))