diff --git a/README b/README index 9a8b403f76511de349bdc3d77aeaff70bb122273..7949be5e71e0e7686d03bcb1fdc6e89618c76f50 100644 --- a/README +++ b/README @@ -102,9 +102,13 @@ RUN/LINES CMD &KEY ON-ERROR TIME SHOW HOST returning as a list of one string per line (stripped of line-ending) what the inferior command sent to its standard output. -*FORCE-SHELL* - a variable to force using a shell, even in cases where INFERIOR-SHELL can run - commands directly. +*BACKEND* + a variable to choose between backends. Currently, only supported are + :AUTO (the default, using xcvb-driver:run-program/, and + spawning a shell unless it's a simple process), and + :SBCL (only available on #+(and sbcl sb-thread unix), + doesn't need a shell but has some limitations such as + only supporting redirection of stdin, stdout, stderr). ==== THE PROCESS-SPEC MINI-LANGUAGE ==== diff --git a/pkgdcl.lisp b/pkgdcl.lisp index 930124f3a77b93e3f8be33aaf45d44d6202bf240..d3172ae4bcf161d1e5b423d1aa96e64ebd290863 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -13,4 +13,4 @@ #:redirection #:file-redirection #:fd-redirection #:close-redirection #:! #:- #:< #:> #:<> #:>! #:>> #:>>! #:<& #:>& #:>&! #:>>&! #:>& #:>> #:>>& #:pipe #:or #:and #:progn #:fork - #:*force-shell*)) + #:*backend*)) diff --git a/run-sbcl.lisp b/run-sbcl.lisp index 1e49c80aac4c999c7e77ab324aae031e65c7a454..9791ef4130f444f3796abded5e3a444a7fb08fc7 100644 --- a/run-sbcl.lisp +++ b/run-sbcl.lisp @@ -75,7 +75,8 @@ (when next (alexandria:flatten (list next (process-result-list next))))))) -(defun sbcl-run (spec input output error) +(defun sbcl-run (spec &key input output error ignore-error-status) + (declare (ignore ignore-error-status)) ;; THIS IS A BUG! (labels ((collect-threads (r) (let ((thread (result-thread r))) (when thread diff --git a/run.lisp b/run.lisp index 454b04323defc834beb3266d70843a8903367ecb..b4400db6c6266f179a9b95376e0f51f2db374eeb 100644 --- a/run.lisp +++ b/run.lisp @@ -2,12 +2,11 @@ (in-package :inferior-shell) -(defvar *force-shell* nil) +(defvar *backend* :auto) ;;; TODO: instead support a magic :interactive directly in driver.lisp's run-program/ ;;; and/or add support for arbitrary input to said run-program/ (defun run-program/interactively (command &key ignore-error-status) - ;; force-shell wait #-(or clozure sbcl) (NIY 'run-program/interactively command ignore-error-status) #+(or clozure sbcl) (let* ((process @@ -41,7 +40,7 @@ :ignore-error-status ignore-error-status :output output)))) -(defun run-process-spec (spec &rest keys &key ignore-error-status output host) +(defun run-process-spec (spec &rest keys &key ignore-error-status output host backend) (etypecase host (null (etypecase spec @@ -52,12 +51,14 @@ (cons (apply 'run-process-spec (parse-process-spec spec) keys)) (process-spec - #+(and sbcl sb-thread unix) - (if (not *force-shell*) - (sbcl-run spec t output t) - (run-spec spec :ignore-error-status ignore-error-status :output output)) - #-(and sbcl sb-thread unix) - (run-spec spec :ignore-error-status ignore-error-status :output output)))) + (ecase (or backend *backend*) + #+(and sbcl sb-thread unix) + ((:sbcl) + (sbcl-run + spec :input (eq :output :interactively) :output output :error t + :ignore-error-status ignore-error-status)) + ((:auto) + (run-spec spec :ignore-error-status ignore-error-status :output output)))))) (string (apply 'run-process-spec (on-host-spec host spec) :host nil keys)) (function diff --git a/test.lisp b/test.lisp index f31e339dae7bd98e306b67b5b32635103a1365d7..9db50d4a661afdd44a50fc27aca839f4a63649e9 100644 --- a/test.lisp +++ b/test.lisp @@ -13,20 +13,15 @@ :in root-suite :documentation "Testing inferior-shell")) -(defmacro w-sh (&body body) - `(let ((*force-shell* t)) - ,@body)) - -(defmacro wo-sh (&body body) - `(let ((*force-shell* t)) - ,@body)) +(defun do-test-inferior-shell () + (is (equal (run/ss "echo 1 2 3") "1 2 3")) + (is (equal (run/ss `(pipe (echo (+ hel "lo,") world) + (tr "hw" "HW") (sed -e "s/$/!/"))) + "Hello, World!"))) (deftest test-inferior-shell () - (is (equal (w-sh (run/ss "echo 1 2 3")) "1 2 3")) - (is (equal (wo-sh (run/ss "echo 1 2 3")) "1 2 3")) - (is (equal (w-sh (run/ss `(pipe (echo (+ hel "lo,") world) - (tr "hw" "HW") (sed -e "s/$/!/")))) - "Hello, World!")) - (is (equal (wo-sh (run/ss `(pipe (echo (+ hel "lo,") world) - (tr "hw" "HW") (sed -e "s/$/!/")))) - "Hello, World!"))) + (let ((*backend* :auto)) + (do-test-inferior-shell)) + #+(and sbcl sb-thread unix) + (let ((*backend* :sbcl)) + (do-test-inferior-shell)))