Skip to content
Snippets Groups Projects
Commit b8089dae authored by Robert Goldman's avatar Robert Goldman
Browse files

Output T unsupported on ABCL.

parent fd28c3c7
No related branches found
No related tags found
No related merge requests found
......@@ -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.)"
......
......@@ -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*)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment