From b8089dae2665eb9acdb398fbcfda646486707d0c Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@sift.net> Date: Fri, 19 Mar 2021 10:12:16 -0500 Subject: [PATCH] Output T unsupported on ABCL. --- test/test-run-program-unix.script | 51 ++++++++++++++++++++----------- uiop/launch-program.lisp | 4 +-- 2 files changed, 35 insertions(+), 20 deletions(-) diff --git a/test/test-run-program-unix.script b/test/test-run-program-unix.script index 7429542a5..1d87633f5 100644 --- a/test/test-run-program-unix.script +++ b/test/test-run-program-unix.script @@ -152,6 +152,12 @@ (define-condition test-failure (error) ()) +(define-condition unexpected-test-success (error) + ((test-designator :initarg :test-designator)) + (:report (lambda (condition stream) + (format stream "On this lisp implementation expected test ~a to fail, but it succeeded." + (slot-value condition 'test-designator))))) + ;;; Testing utilities (defun file-contains-exactly (filename expected-content) @@ -186,6 +192,29 @@ (error 'test-skipped :reason "ext:terminate-process missing")) (apply #'terminate-process rest)) +(defmacro expected-unimplemented ((impl-or-impl-list &key test-designator) + &body body) + (let* ((impl-list (if (listp impl-or-impl-list) + impl-or-impl-list + (list impl-or-impl-list))) + (non-implementing-implementation + `(some #'(lambda (x) (featurep x)) ',impl-list))) + `(when (and ,non-implementing-implementation + (eq + (catch 'unimplemented + (handler-bind + ((not-implemented-error + #'(lambda (x) + (when ,non-implementing-implementation + (format t "~&This behavior is expected to be unimplemented on this lisp.~%")) + (throw 'unimplemented t)))) + ,@body + :implemented + )) + :implemented)) + (error 'unexpected-test-success :test-designator ,test-designator)))) + + ;;; The actual tests (new-test-suite "run-program/launch-program") @@ -212,30 +241,16 @@ (define-test "launch-program :output t" - (catch 'unimplemented - (handler-bind - ( - #+lispworks - (not-implemented-error - #'(lambda (x) - (format t "~&This behavior is expected to be unimplemented on this lisp.~%") - (throw 'unimplemented t)))) + (expected-unimplemented ((:lispworks :abcl) :test-designator "launch-program :output t") (launch-program (list "echo" "echoing output") - :output t)))) + :output t))) (define-test "launch-program :error-output t" - (catch 'unimplemented - (handler-bind - ( - #+lispworks - (not-implemented-error - #'(lambda (x) - (format t "~&This behavior is expected to be unimplemented on this lisp.~%") - (throw 'unimplemented t)))) + (expected-unimplemented ((:lispworks :abcl) :test-designator "launch-program :error-output t") (uiop:wait-process (launch-program (format nil "./exiter.sh 0 ~a" output-string) - :error-output t))))) + :error-output t)))) (define-test ":output <file> (file e.)" diff --git a/uiop/launch-program.lisp b/uiop/launch-program.lisp index a5bd32026..fc0162147 100644 --- a/uiop/launch-program.lisp +++ b/uiop/launch-program.lisp @@ -168,11 +168,11 @@ argument to pass to the internal RUN-PROGRAM" role specifier)) (t (parameter-error "~S IO specifier invalid for ~S" specifier role)))) ((eql t) - #+lispworks + #+ (or lispworks abcl) (not-implemented-error :interactive-output "On this lisp implementation, cannot interpret ~a value of ~a" specifier role) - #-lispworks + #- (or lispworks abcl) (cond ((eq role :error-output) *error-output*) ((eq role :output) #+lispworks *terminal-io* #-lispworks *standard-output*) ((eq role :input) *standard-input*))) -- GitLab