From 4061ec83c80a66d91e68227d9f3a121988d3b581 Mon Sep 17 00:00:00 2001 From: Nathan Hawkins <utsl@quic.net> Date: Mon, 16 Apr 2012 08:05:54 -0400 Subject: [PATCH] Fix a regression where RUN failed except in shellless mode. Increased the test coverage slightly. --- inferior-shell.asd | 3 ++- pkgdcl.lisp | 5 +++-- run.lisp | 14 ++++++++++---- test.lisp | 18 +++++++++++++++--- 4 files changed, 30 insertions(+), 10 deletions(-) diff --git a/inferior-shell.asd b/inferior-shell.asd index 835e6d6..494a59d 100644 --- a/inferior-shell.asd +++ b/inferior-shell.asd @@ -12,8 +12,9 @@ (:file "macros" :depends-on ("pkgdcl")) (:file "host" :depends-on ("pkgdcl")) (:file "run" :depends-on ("process-spec" "macros")) + (:file "run-generic" :depends-on ("process-spec" "macros")) #+ (and sbcl sb-thread unix) - (:file "run-sbcl" :depends-on ("process-spec" "macros")))) + (:file "run-sbcl" :depends-on ("process-spec" "macros" "run-generic")))) (defmethod perform ((op test-op) (system (eql (find-system :inferior-shell)))) (asdf:load-system :inferior-shell-test) diff --git a/pkgdcl.lisp b/pkgdcl.lisp index b710fe1..930124f 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -11,5 +11,6 @@ #:print-process-spec #:parse-process-spec #:command-arguments #:command-redirections #:redirection #:file-redirection #:fd-redirection #:close-redirection - #:! #:- #:< #:> #:<> #:>! #:>> #:>>! #:<& #:>& #:>&! #:>>&! - #:>& #:>> #:>>& #:pipe #:or #:and #:progn #:fork)) + #:! #:- #:< #:> #:<> #:>! #:>> #:>>! #:<& #:>& #:>&! #:>>&! + #:>& #:>> #:>>& #:pipe #:or #:and #:progn #:fork + #:*force-shell*)) diff --git a/run.lisp b/run.lisp index ae78ac5..7329ba0 100644 --- a/run.lisp +++ b/run.lisp @@ -2,6 +2,8 @@ (in-package :inferior-shell) +(defvar *force-shell* nil) + (defun run-program/interactively (command &key ignore-error-status) ;; force-shell wait (let ((return-code @@ -29,9 +31,11 @@ (null (command-redirections spec))) (command-arguments spec) (print-process-spec spec)))) - (run-program/ command - :ignore-error-status ignore-error-status - :output output))) + (if (eq output 't) + (run-program/ command :ignore-error-status ignore-error-status) + (run-program/ command + :ignore-error-status ignore-error-status + :output output)))) (defun run-process-spec (spec &rest keys &key ignore-error-status output host) (declare (ignore ignore-error-status output)) @@ -44,7 +48,9 @@ (apply 'run-process-spec (parse-process-spec spec) keys)) (process-spec #+(and sbcl sb-thread unix) - (sbcl-run spec t output t) + (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)))) (string diff --git a/test.lisp b/test.lisp index aeb852c..f31e339 100644 --- a/test.lisp +++ b/test.lisp @@ -13,8 +13,20 @@ :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)) + (deftest 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/$/!/"))) + (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!"))) -- GitLab