Commit d836afba authored by Elias Pipping's avatar Elias Pipping
Browse files

Fix :if-input-does-not-exist :create/:error

Add a test, too.
parent c261a97a
......@@ -230,6 +230,21 @@
(check-output (format nil "~a~%" output-string))
(check-error-output (format nil "~a~%" error-string))))
(define-test
":input <file> (file m.) :i-i-d-n-e :error"
(progn
(delete-file-if-exists *input-file*)
(with-expected-failure (t)
(run-program "cat" :input *input-file*
:if-input-does-not-exist :error))))
(define-test
":input <file> (file m.) :i-i-d-n-e :create"
(progn
(delete-file-if-exists *input-file*)
(run-program "cat" :input *input-file*
:if-input-does-not-exist :create)))
(define-test
":input <file> (file e.)"
(progn
......
......@@ -431,6 +431,14 @@ argument to pass to the internal RUN-PROGRAM"
;; >128 from exiting in response to a signal by setting this code
(signal-code :initform nil)))
(defun %handle-if-does-not-exist (file if-does-not-exist)
(when (or (stringp file) (pathnamep file))
(ecase if-does-not-exist
((:create :error)
(with-open-file (dummy file :direction :probe
:if-does-not-exist if-does-not-exist)
(declare (ignorable dummy)))))))
(defun launch-program (command &rest keys
&key
input (if-input-does-not-exist :error)
......@@ -466,6 +474,11 @@ INPUT is similar to OUTPUT, except that T designates the
*STANDARD-INPUT* and a stream requested through the :STREAM keyword
would be available through PROCESS-INFO-INPUT.
IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
or a pathname, can take the values :CREATE and :ERROR (the
default). The meaning of these values is analogous to the
IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
ELEMENT-TYPE and EXTERNAL-FORMAT are passed on to your Lisp
implementation, when applicable, for creation of the output stream.
......@@ -489,11 +502,6 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(unless (eq error-output :interactive)
(parameter-error "~S: The only admissible value for ~S is ~S on this lisp"
'launch-program :error-output :interactive))
#+clisp
(when (or (stringp input) (pathnamep input))
(unless (file-exists-p input)
(parameter-error "~S: Files passed as arguments to ~S need to exist on this lisp"
'launch-program :input)))
#+ecl
(when (some #'(lambda (stream)
(and (streamp stream)
......@@ -501,6 +509,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(list input output error-output))
(parameter-error "~S: Streams passed as I/O parameters need to be (synonymous with) file streams on this lisp"
'launch-program))
(%handle-if-does-not-exist input if-input-does-not-exist)
#+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
(let* ((%command (%normalize-command command))
(%if-output-exists (%normalize-if-exists if-output-exists))
......@@ -529,7 +538,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
`(:input ,%input :output ,%output
#.(or #+(or allegro lispworks) :error-output :error) ,%error-output
:wait nil :element-type ,element-type :external-format ,external-format
:if-input-does-not-exist ,if-input-does-not-exist
:if-input-does-not-exist :error
:if-output-exists ,%if-output-exists
#-(or allegro lispworks) :if-error-exists
#+(or allegro lispworks) :if-error-output-exists ,if-error-output-exists
......@@ -964,10 +973,12 @@ or :error-output."
((os-unix-p) `(,@(when redirections `("exec " ,@redirections " ; ")) ,@chdir ,normalized))
((os-windows-p) `(,@chdir ,@redirections " " ,normalized)))))))
(defun %system (command &rest keys
&key input output error-output directory &allow-other-keys)
(defun %system (command &rest keys &key directory
input if-input-does-not-exist
output error-output &allow-other-keys)
"A portable abstraction of a low-level call to libc's system()."
(declare (ignorable input output error-output directory keys))
(declare (ignorable output error-output directory keys))
(%handle-if-does-not-exist input if-input-does-not-exist)
#+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl)
(wait-process
(apply 'launch-program (%normalize-system-command command) :wait t keys))
......@@ -1062,6 +1073,11 @@ in which case NIL is returned.
INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
no value is returned, and T designates the *STANDARD-INPUT*.
IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
or a pathname, can take the values :CREATE and :ERROR (the
default). The meaning of these values is analogous to the
IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
to your Lisp implementation, when applicable, for creation of the output stream.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment