Commit c53cca18 authored by Martin Simmons's avatar Martin Simmons Committed by Robert Goldman
Browse files

Reimplement with-null-input and with-null-output entirely in Lisp, avoiding...

Reimplement with-null-input and with-null-output entirely in Lisp, avoiding access to system devices.
parent aff5583d
...@@ -280,32 +280,34 @@ and always returns EOF when read from" ...@@ -280,32 +280,34 @@ and always returns EOF when read from"
((os-unix-p) #p"/dev/null") ((os-unix-p) #p"/dev/null")
((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax? ((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax?
(t (error "No /dev/null on your OS")))) (t (error "No /dev/null on your OS"))))
(defun call-with-null-input (fun &rest keys &key element-type external-format if-does-not-exist) (defun call-with-null-input (fun &key element-type external-format if-does-not-exist)
"Call FUN with an input stream from the null device; pass keyword arguments to OPEN." "Call FUN with an input stream that always returns end of file.
The keyword arguments are allowed for backward compatibility, but are ignored."
(declare (ignore element-type external-format if-does-not-exist)) (declare (ignore element-type external-format if-does-not-exist))
(apply 'call-with-input-file (null-device-pathname) fun keys)) (with-open-stream (input (make-concatenated-stream))
(funcall fun input)))
(defmacro with-null-input ((var &rest keys (defmacro with-null-input ((var &rest keys
&key element-type external-format if-does-not-exist) &key element-type external-format if-does-not-exist)
&body body) &body body)
(declare (ignore element-type external-format if-does-not-exist)) (declare (ignore element-type external-format if-does-not-exist))
"Evaluate BODY in a context when VAR is bound to an input stream accessing the null device. "Evaluate BODY in a context when VAR is bound to an input stream that always returns end of file.
Pass keyword arguments to OPEN." The keyword arguments are allowed for backward compatibility, but are ignored."
`(call-with-null-input #'(lambda (,var) ,@body) ,@keys)) `(call-with-null-input #'(lambda (,var) ,@body) ,@keys))
(defun call-with-null-output (fun (defun call-with-null-output (fun
&key (element-type *default-stream-element-type*) &key (element-type *default-stream-element-type*)
(external-format *utf-8-external-format*) (external-format *utf-8-external-format*)
(if-exists :overwrite) (if-exists :overwrite)
(if-does-not-exist :error)) (if-does-not-exist :error))
"Call FUN with an output stream to the null device; pass keyword arguments to OPEN." (declare (ignore element-type external-format if-exists if-does-not-exist))
(call-with-output-file "Call FUN with an output stream that discards all output.
(null-device-pathname) fun The keyword arguments are allowed for backward compatibility, but are ignored."
:element-type element-type :external-format external-format (with-open-stream (output (make-broadcast-stream))
:if-exists if-exists :if-does-not-exist if-does-not-exist)) (funcall fun output)))
(defmacro with-null-output ((var &rest keys (defmacro with-null-output ((var &rest keys
&key element-type external-format if-does-not-exist if-exists) &key element-type external-format if-does-not-exist if-exists)
&body body) &body body)
"Evaluate BODY in a context when VAR is bound to an output stream accessing the null device. "Evaluate BODY in a context when VAR is bound to an output stream that discards all output.
Pass keyword arguments to OPEN." The keyword arguments are allowed for backward compatibility, but are ignored."
(declare (ignore element-type external-format if-exists if-does-not-exist)) (declare (ignore element-type external-format if-exists if-does-not-exist))
`(call-with-null-output #'(lambda (,var) ,@body) ,@keys))) `(call-with-null-output #'(lambda (,var) ,@body) ,@keys)))
......
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