[git] CMU Common Lisp branch master updated. snapshot-2014-02-7-g8e32631

Raymond Toy rtoy at common-lisp.net
Mon Feb 10 01:20:44 UTC 2014


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  8e32631b0fd464a6f753639f02ceb36d58eeabde (commit)
       via  53c2f46a97425ce7af98550529711de3293a5692 (commit)
      from  f04a80287e33b51b08242d53e7ad7c1c2ec9c59e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 8e32631b0fd464a6f753639f02ceb36d58eeabde
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Feb 9 17:20:35 2014 -0800

    Update from logs.

diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt
index fdc8837..de3f682 100644
--- a/src/general-info/release-20f.txt
+++ b/src/general-info/release-20f.txt
@@ -24,6 +24,9 @@ New in this release:
     * Trig functions are signficantly faster.
     * Accuracy of trig functions improved. (Previously, they could be
       off by one or two ulp.)
+    * RUN-PROGRAM accepts :ELEMENT-TYPE to allow specifying the
+      element type for streams that are created for RUN-PROGRAM.  (See
+      ticket:92)
 
   * Changes
     * Update to ASDF 3.0.3.
@@ -69,6 +72,7 @@ New in this release:
   * Trac Tickets:
     * Ticket #90 fixed.
     * Ticket #92 fixed.
+    * Ticket #87 fixed.
 
   * Other changes:
 

commit 53c2f46a97425ce7af98550529711de3293a5692
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Feb 9 17:18:49 2014 -0800

    Fix ticket:87
    
    Add {{{:ELEMENT-TYPE}}} keyword option to {{{RUN-PROGRAM}}}
    
     * src/code/run-program.lisp:
       * Add :element-type option, and use it as needed when creating
         input or output streams.
    
     * tests/trac.lisp:
       * Add tests.

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index c8f96e9..ee29dfa 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -456,7 +456,8 @@
 		    &key (env *environment-list*) (wait t) pty input
 		    if-input-does-not-exist output (if-output-exists :error)
 		    (error :output) (if-error-exists :error) status-hook
-		    (external-format :default))
+		    (external-format :default)
+		    (element-type 'base-char))
   "RUN-PROGRAM creates a new process and runs the unix program in the
    file specified by the simple-string PROGRAM.  ARGS are the standard
    arguments that can be passed to a Unix program, for no arguments
@@ -510,7 +511,11 @@
         This is a function the system calls whenever the status of the
         process changes.  The function takes the process as an argument.
      :external-format -
-        This is the external-format used for communication with the subprocess."
+        This is the external-format used for communication with the subprocess.
+     :element-type -
+        When a stream is created for :input or :output, the stream
+        uses this element-type instead of the default 'BASE-CHAR type.
+"
 
   ;; Make sure the interrupt handler is installed.
   (system:enable-interrupt unix:sigchld #'sigchld-handler)
@@ -531,13 +536,15 @@
 	      (stdin input-stream)
 	      (get-descriptor-for input cookie :direction :input
 				  :if-does-not-exist if-input-does-not-exist
-				  :external-format external-format)
+				  :external-format external-format
+				  :element-type element-type)
 	    (multiple-value-bind
 		(stdout output-stream)
 		(get-descriptor-for output cookie :direction :output
                                     :if-does-not-exist :create
 				    :if-exists if-output-exists
-				    :external-format external-format)
+				    :external-format external-format
+				    :element-type element-type)
 	      (multiple-value-bind
 		  (stderr error-stream)
 		  (if (eq error :output)
@@ -545,7 +552,8 @@
 		      (get-descriptor-for error cookie :direction :output
                                           :if-does-not-exist :create
 					  :if-exists if-error-exists
-					  :external-format external-format))
+					  :external-format external-format
+					  :element-type element-type))
 		(multiple-value-bind (pty-name pty-stream)
 				     (open-pty pty cookie external-format)
 		  ;; Make sure we are not notified about the child death before
@@ -652,6 +660,7 @@
 ;;; 
 (defun get-descriptor-for (object cookie &rest keys &key direction
 							 external-format
+						         (element-type 'base-char)
 				  &allow-other-keys)
   (cond ((eq object t)
 	 ;; No new descriptor is needed.
@@ -684,14 +693,18 @@
 	      (push write-fd *close-on-error*)
 	      (let ((stream (system:make-fd-stream write-fd :output t
 						   :external-format
-						   external-format)))
+						   external-format
+						   :element-type
+						   element-type)))
 		(values read-fd stream)))
 	     (:output
 	      (push read-fd *close-on-error*)
 	      (push write-fd *close-in-parent*)
 	      (let ((stream (system:make-fd-stream read-fd :input t
 						   :external-format
-						   external-format)))
+						   external-format
+						   :element-type
+						   element-type)))
 		(values write-fd stream)))
 	     (t
 	      (unix:unix-close read-fd)
diff --git a/tests/trac.lisp b/tests/trac.lisp
index dfbbf8b..87e3ca7 100644
--- a/tests/trac.lisp
+++ b/tests/trac.lisp
@@ -274,6 +274,50 @@
   (assert-true (ignore-errors (format nil "~ve" 21 5d-234)))
   (assert-true (ignore-errors (format nil "~ve" 100 5d-234))))
 
+(define-test trac.87.output
+  (:tag :trac)
+  (let ((path "/tmp/trac.87")
+	(string "Hello"))
+    (unwind-protect
+	 (progn
+	   (with-open-file (s path :direction :output :if-exists :supersede
+			      :external-format :latin1)
+	     (write-string string s))
+	   (let* ((expected (stream:string-to-octets string :external-format :latin1))
+		  (octets (make-array (length expected)
+				      :element-type '(unsigned-byte 8)))
+		  (proc (ext:run-program "/bin/cat" (list path)
+					 :output :stream
+					 :element-type '(unsigned-byte 8))))
+	     (read-sequence octets (ext:process-output proc))
+	     (assert-equalp
+	      expected
+	      octets)))
+      (delete-file path))))
+
+(define-test trac.87.input
+  (:tag :trac)
+  (let ((path "/tmp/trac.87")
+	(string "Hello"))
+    (unwind-protect
+	 (progn
+	   (with-open-file (s path :direction :output :if-exists :supersede
+			      :external-format :latin1)
+	     (write-string string s))
+	   (let ((octets (stream:string-to-octets string :external-format :latin1))
+		 (output (make-array (length string)
+				     :element-type '(unsigned-byte 8)))
+		 (proc (ext:run-program "/bin/cat" (list path)
+					:input :stream
+					:output :stream
+					:element-type '(unsigned-byte 8))))
+	     (write-sequence octets (ext:process-input proc))
+	     (read-sequence output (ext:process-output proc))
+	     (assert-equalp
+	      octets
+	      output)))
+      (delete-file path))))
+      
 (define-test trac.92
   (:tag :trac)
   (let ((f (compile nil
@@ -283,3 +327,4 @@
     (assert-equal
      'double-float
      (third (kernel:%function-type f)))))
+

-----------------------------------------------------------------------

Summary of changes:
 src/code/run-program.lisp        |   27 +++++++++++++++++------
 src/general-info/release-20f.txt |    4 ++++
 tests/trac.lisp                  |   45 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 69 insertions(+), 7 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp



More information about the cmucl-cvs mailing list