Commit 24a53ee2 authored by Antoine Martin's avatar Antoine Martin
Browse files

Use UIOP:RUN-PROGRAM and log qrmapper errors

Fixes #45
Fixes #49
parent 73af580f
......@@ -27,32 +27,35 @@
(alexandria:flatten args))
(defun run-sbcl (&key file pre-file environment-pairs evals)
(run-program (native-truename *sbcl-program*)
(flatlist "--noinform"
"--non-interactive"
"--no-userinit"
"--no-sysinit"
"--load" (native-truename
(ql-setup:qmerge "setup.lisp"))
(eval-defvar-forms environment-pairs)
"--eval"
(format nil "(setf cl:*default-pathname-defaults* ~
#p~S)"
(native-truename *default-pathname-defaults*))
"--load"
(native-truename *init-file*)
(when pre-file
(list "--load" (native-truename pre-file)))
(mapcar (lambda (eval)
(list "--eval" eval))
evals)
"--eval"
(format nil "(defparameter *remove-cache* ~S)"
*remove-cache*)
"--load" (native-truename file))
:environment (append (environment-list environment-pairs)
(sb-ext:posix-environ))
:output *standard-output*))
(uiop:run-program (flatlist
(native-truename *sbcl-program*)
"--noinform"
"--non-interactive"
"--no-userinit"
"--no-sysinit"
"--load" (native-truename
(ql-setup:qmerge "setup.lisp"))
(eval-defvar-forms environment-pairs)
"--eval"
(format nil "(setf cl:*default-pathname-defaults* ~
#p~S)"
(native-truename *default-pathname-defaults*))
"--load"
(native-truename *init-file*)
(when pre-file
(list "--load" (native-truename pre-file)))
(mapcar (lambda (eval)
(list "--eval" eval))
evals)
"--eval"
(format nil "(defparameter *remove-cache* ~S)"
*remove-cache*)
"--load" (native-truename file))
:environment (append (environment-list environment-pairs)
(sb-ext:posix-environ))
:output :string
:error-output :output
:ignore-error-status t))
(defgeneric base-directory (object)
(:method ((release ql-dist:release))
......@@ -74,11 +77,23 @@
(ql-dist:ensure-installed object)
(let ((*default-pathname-defaults*
(base-directory object)))
(run-sbcl :file file
:pre-file pre-file
:environment-pairs (list "*qrmapper-object-name*"
name)
:evals evals))))))))
(let* ((l (multiple-value-list
(run-sbcl :file file
:pre-file pre-file
:environment-pairs
(list "*qrmapper-object-name*"
name)
:evals evals)))
(status (nth 2 l))
(output (first l)))
(when (not (eql status 0))
(with-open-file (file
(from-quickref-dir
(format nil "logs/declt-map/~A.log" name))
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(format file "~A~%" output)))))))))))
(defun map-releases (file &key (dist-name "quicklisp") (filter 'identity)
pre-file)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment