Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Gary Palter
asdf
Commits
cbfe250a
Commit
cbfe250a
authored
Mar 20, 2021
by
Robert Goldman
Browse files
Merge branch 'iss61' into 'master'
Fix for issue 61 See merge request
!165
parents
33dc3301
b8089dae
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/test-run-program-unix.script
View file @
cbfe250a
...
...
@@ -51,7 +51,7 @@
(defvar *test-number*)
(defvar *suites* nil)
(defvar *suites-reversed* t)
(defvar *letters* "abcdefghijklmnopqrstuvwxyz")
(defvar *letters* "abcdefghijklmnopqrstuvwxyz
ABCDEFGHIJKLMNOPQRSTUVWXYZ
")
(defvar *number-of-failed-tests* 0)
(defvar *number-of-skipped-tests* 0)
(defvar *number-of-unsupported-tests* 0)
...
...
@@ -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")
...
...
@@ -205,7 +234,23 @@
(run-program (format nil "./exiter.sh 0 ~a" output-string)
:error-output :output))
(define-test
"run-program :output t"
(run-program (list "/bin/echo" "echoing output")
:output t))
(define-test
"launch-program :output t"
(expected-unimplemented ((:lispworks :abcl) :test-designator "launch-program :output t")
(launch-program (list "echo" "echoing output")
:output t)))
(define-test
"launch-program :error-output 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))))
(define-test
":output <file> (file e.)"
...
...
uiop/launch-program.lisp
View file @
cbfe250a
...
...
@@ -167,6 +167,15 @@ argument to pass to the internal RUN-PROGRAM"
"Can't send ~a to ~a on this lisp implementation."
role
specifier
))
(
t
(
parameter-error
"~S IO specifier invalid for ~S"
specifier
role
))))
((
eql
t
)
#+
(
or
lispworks
abcl
)
(
not-implemented-error
:interactive-output
"On this lisp implementation, cannot interpret ~a value of ~a"
specifier
role
)
#-
(
or
lispworks
abcl
)
(
cond
((
eq
role
:error-output
)
*error-output*
)
((
eq
role
:output
)
#+
lispworks
*terminal-io*
#-
lispworks
*standard-output*
)
((
eq
role
:input
)
*standard-input*
)))
(
otherwise
(
parameter-error
"Incorrect I/O specifier ~S for ~S"
specifier
role
))))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment