Commit 46d62aae authored by Elias Pipping's avatar Elias Pipping

Fix :if-output-exists :append/:supersede/:error

Add a test, too.
parent d836afba
......@@ -262,7 +262,7 @@
:if-input-does-not-exist :create)))
(define-test
":input <file> :output <file> (files e.)"
":input <file> :output <file> (files e.) :i-o-e :supersede"
(let ((in-string (format nil "A line.~%And another.~%")))
(create-file-from-string *input-file* in-string)
(create-file-from-string *output-file* "")
......@@ -270,7 +270,37 @@
(check-output in-string)))
(define-test
":input <file> :output <file> (files e./m.)"
":input <file> :output <file> (files e.) :i-o-e :error"
(progn
(let ((in-string1 (format nil "A line.~%"))
(in-string2 (format nil "And another.~%")))
(delete-file-if-exists *output-file*)
(create-file-from-string *input-file* in-string1)
(run-program "cat" :input *input-file*
:output *output-file*)
(create-file-from-string *input-file* in-string2)
(with-expected-failure (t)
(run-program "cat" :input *input-file*
:output *output-file* :if-output-exists :error))
(check-output in-string1))))
(define-test
":input <file> :output <file> (files e.) :i-o-e :append"
(progn
(let ((in-string1 (format nil "A line.~%"))
(in-string2 (format nil "And another.~%")))
(delete-file-if-exists *output-file*)
(create-file-from-string *input-file* in-string1)
(run-program "cat" :input *input-file*
:output *output-file*)
(create-file-from-string *input-file* in-string2)
(run-program "cat" :input *input-file*
:output *output-file*
:if-output-exists :append)
(check-output (concatenate 'string in-string1 in-string2)))))
(define-test
":input <file> :output <file> (files e./m.) :i-o-e :supersede"
(let ((in-string (format nil "A line.~%And another.~%")))
(create-file-from-string *input-file* in-string)
(delete-file-if-exists *output-file*)
......
......@@ -401,11 +401,6 @@ argument to pass to the internal RUN-PROGRAM"
:output
(error "Wrong specifier ~S for role ~S" specifier role)))))
(defun %normalize-if-exists (action)
(ecase action
(:supersede #+clisp :overwrite #-clisp action)
((:append :error) action)))
(defun %interactivep (input output error-output)
(member :interactive (list input output error-output)))
......@@ -431,6 +426,13 @@ 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-exists (file if-exists)
(when (or (stringp file) (pathnamep file))
(ecase if-exists
((:append :supersede :error)
(with-open-file (dummy file :direction :output :if-exists if-exists)
(declare (ignorable dummy)))))))
(defun %handle-if-does-not-exist (file if-does-not-exist)
(when (or (stringp file) (pathnamep file))
(ecase if-does-not-exist
......@@ -465,6 +467,12 @@ stream will be made available that can be accessed via
PROCESS-INFO-OUTPUT and read from. Otherwise, OUTPUT should be a value
that the underlying lisp implementation knows how to handle.
IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
default). The meaning of these values and their effect on the case
where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
to OPEN with :DIRECTION :OUTPUT.
ERROR-OUTPUT is similar to OUTPUT. T designates the *ERROR-OUTPUT*,
:OUTPUT means redirecting the error output to the output stream,
and :STREAM causes a stream to be made available via
......@@ -510,9 +518,9 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(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)
(%handle-if-exists output if-output-exists)
#+(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))
(%input (%normalize-io-specifier input :input))
(%output (%normalize-io-specifier output :output))
(%error-output (%normalize-io-specifier error-output :error-output))
......@@ -539,7 +547,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#.(or #+(or allegro lispworks) :error-output :error) ,%error-output
:wait nil :element-type ,element-type :external-format ,external-format
:if-input-does-not-exist :error
:if-output-exists ,%if-output-exists
:if-output-exists :append
#-(or allegro lispworks) :if-error-exists
#+(or allegro lispworks) :if-error-output-exists ,if-error-output-exists
:allow-other-keys t)
......@@ -960,7 +968,7 @@ or :error-output."
(when pathname
(list operator " "
(escape-shell-token (native-namestring pathname)))))))
(let* ((redirections (append (redirect in " <") (redirect out " >") (redirect err " 2>")))
(let* ((redirections (append (redirect in " <") (redirect out " >>") (redirect err " 2>")))
(normalized (%normalize-system-command command))
(directory (or directory #+(or abcl xcl) (getcwd)))
(chdir (when directory
......@@ -975,10 +983,12 @@ or :error-output."
(defun %system (command &rest keys &key directory
input if-input-does-not-exist
output error-output &allow-other-keys)
output if-output-exists
error-output &allow-other-keys)
"A portable abstraction of a low-level call to libc's system()."
(declare (ignorable output error-output directory keys))
(declare (ignorable error-output directory keys))
(%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
#+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl)
(wait-process
(apply 'launch-program (%normalize-system-command command) :wait t keys))
......@@ -1065,6 +1075,12 @@ E.g., using :OUTPUT :STRING will have it return the entire output stream as a st
And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
stripped of any ending newline.
IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
default). The meaning of these values and their effect on the case
where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
to OPEN with :DIRECTION :OUTPUT.
ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
Also :OUTPUT means redirecting the error output to 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