Commit 72670360 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'run-program-if-exists' into 'master'

Fix run-program's file existence check interface

This fixes https://bugs.launchpad.net/asdf/+bug/1629680.

See merge request !35
parents abffd39c 0a240312
#!/bin/sh
cat "$@" >&2
......@@ -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
......@@ -247,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* "")
......@@ -255,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*)
......@@ -263,6 +308,37 @@
:output *output-file*)
(check-output in-string)))
(define-test
":input <file> :error-output <file> (files e.), :i-e-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-to-stderr.sh" :input *input-file*
:error-output *error-output-file*)
(create-file-from-string *input-file* in-string2)
(with-expected-failure (t)
(run-program "./cat-to-stderr.sh" :input *input-file*
:error-output *error-output-file*
:if-error-output-exists :error))
(check-error-output in-string1))))
(define-test
":input <file> :error-output <file> (files e.), :i-e-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-to-stderr.sh" :input *input-file*
:error-output *error-output-file*)
(create-file-from-string *input-file* in-string2)
(run-program "./cat-to-stderr.sh" :input *input-file*
:error-output *error-output-file*
:if-error-output-exists :append)
(check-error-output (concatenate 'string in-string1 in-string2)))))
(define-test
":output <fstream> :error-output <fstream>"
(progn
......
......@@ -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,21 @@ 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
((: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)
......@@ -457,15 +467,29 @@ 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
PROCESS-INFO-ERROR-OUTPUT.
IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
affects ERROR-OUTPUT rather than OUTPUT.
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 +513,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,9 +520,11 @@ 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)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-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))
......@@ -529,10 +550,10 @@ 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-output-exists ,%if-output-exists
:if-input-does-not-exist :error
:if-output-exists :append
#-(or allegro lispworks) :if-error-exists
#+(or allegro lispworks) :if-error-output-exists ,if-error-output-exists
#+(or allegro lispworks) :if-error-output-exists :append
:allow-other-keys t)
#+allegro `(:directory ,directory)
#+(and allegro os-windows) `(:show-window ,(if interactive nil :hide))
......@@ -944,14 +965,14 @@ or :error-output."
(string (parse-native-namestring spec))
(pathname spec)
((eql :output)
(unless (equal operator " 2>")
(unless (equal operator " 2>>")
(parameter-error "~S: only the ~S argument can be ~S"
'run-program :error-output :output))
(return-from redirect '(" 2>&1"))))))
(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
......@@ -964,10 +985,16 @@ 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 if-output-exists
error-output if-error-output-exists
&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 directory keys))
(%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-output-exists)
#+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl)
(wait-process
(apply 'launch-program (%normalize-system-command command) :wait t keys))
......@@ -1054,14 +1081,28 @@ 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,
in which case NIL is returned.
IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
affects ERROR-OUTPUT rather than OUTPUT.
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