From 3189006493c5d7389dde68eff83f713074946d5e Mon Sep 17 00:00:00 2001 From: Rudi Schlatte Date: Thu, 25 Sep 2003 12:12:10 +0000 Subject: [PATCH] 0.8.3.93 Make double-channel simple streams work ... conditionalize flush-buffer etc. for code shared between single-channel and double-channel simple streams (Thanks to David Lichteblau for the reports) --- contrib/sb-simple-streams/TODO | 2 + contrib/sb-simple-streams/classes.lisp | 6 +- contrib/sb-simple-streams/impl.lisp | 3 +- contrib/sb-simple-streams/internal.lisp | 10 +- contrib/sb-simple-streams/simple-stream-tests.lisp | 169 ++++++++++---------- contrib/sb-simple-streams/strategy.lisp | 7 +- version.lisp-expr | 2 +- 7 files changed, 107 insertions(+), 92 deletions(-) diff --git a/contrib/sb-simple-streams/TODO b/contrib/sb-simple-streams/TODO index 668dfb2..9f37d97 100644 --- a/contrib/sb-simple-streams/TODO +++ b/contrib/sb-simple-streams/TODO @@ -2,6 +2,8 @@ - Implement & test read-sequence, write-sequence for (un)signed-8 vectors +- Eliminate consing in sc-read-chars-ef + - Make reader work with simple-streams - external format handling: load aliases, load formats, etc. diff --git a/contrib/sb-simple-streams/classes.lisp b/contrib/sb-simple-streams/classes.lisp index a3a8cec..0bc782d 100644 --- a/contrib/sb-simple-streams/classes.lisp +++ b/contrib/sb-simple-streams/classes.lisp @@ -75,7 +75,7 @@ (oc-state :initform nil) ;; TODO: find out what this one does (co-state :initform nil) - (external-format :initform :default) + (external-format :initform (find-external-format :default)) ;; A fixnum (denoting a valid file descriptor), a stream, or nil if ;; the stream is not open for input. @@ -191,8 +191,8 @@ (when (any-stream-instance-flags stream :input :output) (when (any-stream-instance-flags stream :output) (ignore-errors (if abort - (clear-output stream) - (force-output stream)))) + (clear-output stream) + (finish-output stream)))) (call-next-method) (setf (sm input-handle stream) nil (sm output-handle stream) nil) diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp index f85edeb..35c316a 100644 --- a/contrib/sb-simple-streams/impl.lisp +++ b/contrib/sb-simple-streams/impl.lisp @@ -292,7 +292,8 @@ (if (not (or (eql width 1) (null width))) (funcall-stm-handler j-listen (sm melded-stream stream)) (or (< (sm buffpos stream) (sm buffer-ptr stream)) - (when (>= (sm mode stream) 0) ;; device-connected @@ single-channel + (when (or (not (any-stream-instance-flags stream :dual :string)) + (>= (sm mode stream) 0)) ;; device-connected @@ single-channel (let ((lcrs (sm last-char-read-size stream))) (unwind-protect (progn diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp index da127f7..1df77e9 100644 --- a/contrib/sb-simple-streams/internal.lisp +++ b/contrib/sb-simple-streams/internal.lisp @@ -13,7 +13,6 @@ ;;; ********************************************************************** ;;; ;;; Various functions needed by simple-streams - (declaim (inline buffer-sap bref (setf bref) buffer-copy allocate-buffer free-buffer)) @@ -28,13 +27,17 @@ (defun bref (buffer index) (declare (type simple-stream-buffer buffer) (type (integer 0 #.most-positive-fixnum) index)) - (sb-sys:sap-ref-8 (buffer-sap buffer) index)) + (if (vectorp buffer) + (sb-sys:sap-ref-8 (sb-sys:vector-sap buffer) index)) + (sb-sys:sap-ref-8 buffer index)) (defun (setf bref) (octet buffer index) (declare (type (unsigned-byte 8) octet) (type simple-stream-buffer buffer) (type (integer 0 #.most-positive-fixnum) index)) - (setf (sb-sys:sap-ref-8 (buffer-sap buffer) index) octet)) + (if (vectorp buffer) + (setf (sb-sys:sap-ref-8 (sb-sys:vector-sap buffer) index) octet) + (setf (sb-sys:sap-ref-8 buffer index) octet))) (defun buffer-copy (src soff dst doff length) (declare (type simple-stream-buffer src dst) @@ -303,6 +306,7 @@ (type (or null simple-stream-buffer) buffer) (type fixnum start) (type (or null fixnum) end) + (type blocking blocking) (optimize (speed 3) (space 2) (safety 0) (debug 0))) (with-stream-class (simple-stream stream) (let ((fd (sm input-handle stream)) diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp index b57d17d..6515a94 100644 --- a/contrib/sb-simple-streams/simple-stream-tests.lisp +++ b/contrib/sb-simple-streams/simple-stream-tests.lisp @@ -10,10 +10,14 @@ "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.") (defparameter *test-path* - (merge-pathnames (make-pathname :name nil :type nil :version nil) + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) *load-truename*) "Directory for temporary test files.") +(defparameter *test-file* + (merge-pathnames #p"test-data.txt" *test-path*)) + (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) ;;; Non-destructive functional analog of REMF @@ -49,38 +53,36 @@ (deftest create-file-1 - ;; Create a file-simple-stream, write data. - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) + ;; Create a file-simple-stream, write data. (prog1 (with-open-stream (s (make-instance 'file-simple-stream - :filename file + :filename *test-file* :direction :output :if-exists :overwrite :if-does-not-exist :create)) (string= (write-string *dumb-string* s) *dumb-string*)) - (delete-file file))) + (delete-file *test-file*)) t) (deftest create-file-2 - ;; Create a file-simple-stream via :class argument to open, write data. - (let ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :output - :if-exists :overwrite :if-does-not-exist :create) - (string= (write-string *dumb-string* s) *dumb-string*))) + ;; Create a file-simple-stream via :class argument to open, write data. + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :output :if-exists :overwrite + :if-does-not-exist :create) + (string= (write-string *dumb-string* s) *dumb-string*)) t) (deftest create-read-file-1 ;; Via file-simple-stream objects, write and then re-read data. - (let ((result t) - (file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :output - :if-exists :overwrite :if-does-not-exist :create - :delete-afterwards nil) + (let ((result t)) + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :output :if-exists :overwrite + :if-does-not-exist :create :delete-afterwards nil) (write-line *dumb-string* s) (setf result (and result (string= (write-string *dumb-string* s) *dumb-string*)))) - (with-test-file (s file :class 'file-simple-stream + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :if-does-not-exist :error) ;; Check first line (multiple-value-bind (string missing-newline-p) @@ -97,9 +99,8 @@ (deftest create-read-mapped-file-1 ;; Read data via a mapped-file-simple-stream object. - (let ((result t) - (file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'mapped-file-simple-stream + (let ((result t)) + (with-test-file (s *test-file* :class 'mapped-file-simple-stream :direction :input :if-does-not-exist :error :initial-content *dumb-string*) (setf result (and result (string= (read-line s) *dumb-string*)))) @@ -110,7 +111,8 @@ (handler-case (with-open-stream (s (make-instance 'socket-simple-stream :remote-host #(127 0 0 1) - :remote-port 7)) + :remote-port 7 + :direction :io)) (string= (prog1 (write-line "Got it!" s) (finish-output s)) (read-line s))) (sb-bsd-sockets::connection-refused-error () t)) @@ -119,24 +121,22 @@ (deftest write-read-large-sc-1 ;; Do write and read with more data than the buffer will hold ;; (single-channel simple-stream) - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)) - (stream (make-instance 'file-simple-stream - :filename file :direction :output + (let* ((stream (make-instance 'file-simple-stream + :filename *test-file* :direction :output :if-exists :overwrite :if-does-not-exist :create)) (content (make-string (1+ (device-buffer-length stream)) :initial-element #\x))) (with-open-stream (s stream) (write-string content s)) - (with-test-file (s file :class 'file-simple-stream + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :if-does-not-exist :error) (string= content (read-line s)))) t) (deftest write-read-large-sc-2 - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)) - (stream (make-instance 'file-simple-stream - :filename file :direction :output + (let* ((stream (make-instance 'file-simple-stream + :filename *test-file* :direction :output :if-exists :overwrite :if-does-not-exist :create)) (length (1+ (* 3 (device-buffer-length stream)))) @@ -145,7 +145,7 @@ (setf (aref content i) (code-char (random 256)))) (with-open-stream (s stream) (write-string content s)) - (with-test-file (s file :class 'file-simple-stream + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :if-does-not-exist :error) (let ((seq (make-string length))) #+nil (read-sequence seq s) @@ -155,9 +155,8 @@ t) (deftest write-read-large-sc-3 - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)) - (stream (make-instance 'file-simple-stream - :filename file :direction :output + (let* ((stream (make-instance 'file-simple-stream + :filename *test-file* :direction :output :if-exists :overwrite :if-does-not-exist :create)) (length (1+ (* 3 (device-buffer-length stream)))) @@ -166,7 +165,7 @@ (setf (aref content i) (random 256))) (with-open-stream (s stream) (write-sequence content s)) - (with-test-file (s file :class 'file-simple-stream + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :if-does-not-exist :error) (let ((seq (make-array length :element-type '(unsigned-byte 8)))) #+nil (read-sequence seq s) @@ -181,7 +180,8 @@ (handler-case (let* ((stream (make-instance 'socket-simple-stream :remote-host #(127 0 0 1) - :remote-port 7)) + :remote-port 7 + :direction :io)) (content (make-string (1+ (device-buffer-length stream)) :initial-element #\x))) (with-open-stream (s stream) @@ -192,75 +192,79 @@ (deftest file-position-1 - ;; Test reading of file-position - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :input + ;; Test reading of file-position + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :initial-content *dumb-string*) - (file-position s))) + (file-position s)) 0) -;;; file-position-2 fails ONLY when called with -;;; (asdf:oos 'asdf:test-op :sb-simple-streams) -;;; TODO: Find out why (deftest file-position-2 - ;; Test reading of file-position - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :input + ;; Test reading of file-position + (with-test-file (s *test-file* :class 'file-simple-stream :direction :input :initial-content *dumb-string*) (read-byte s) - (file-position s))) + (file-position s)) 1) (deftest file-position-3 - ;; Test reading of file-position in the presence of unsaved data - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :output - :if-exists :supersede :if-does-not-exist :create) + ;; Test reading of file-position in the presence of unsaved data + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :output :if-exists :supersede + :if-does-not-exist :create) (write-byte 50 s) - (file-position s))) + (file-position s)) 1) (deftest file-position-4 + ;; Test reading of file-position in the presence of unsaved data and + ;; filled buffer + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io + :if-exists :overwrite :if-does-not-exist :create + :initial-content *dumb-string*) + (read-byte s) ; fill buffer + (write-byte 50 s) ; advance file-position + (file-position s)) + 2) + +(deftest file-position-5 ;; Test file position when opening with :if-exists :append - (let ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :io - :if-exists :append :if-does-not-exist :create - :initial-content "Foo") - (= (file-length s) (file-position s)))) + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io + :if-exists :append :if-does-not-exist :create + :initial-content *dumb-string*) + (= (file-length s) (file-position s))) T) (deftest write-read-unflushed-sc-1 - ;; Write something into a single-channel stream and read it back - ;; without explicitly flushing the buffer in-between - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :io + ;; Write something into a single-channel stream and read it back + ;; without explicitly flushing the buffer in-between + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io :if-does-not-exist :create :if-exists :supersede) (write-char #\x s) (file-position s :start) - (read-char s))) + (read-char s)) #\x) (deftest write-read-unflushed-sc-2 - ;; Write something into a single-channel stream, try to read back too much - (handler-case - (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :io - :if-does-not-exist :create :if-exists :supersede) - (write-char #\x s) - (file-position s :start) - (read-char s) - (read-char s)) - nil) - (end-of-file () t)) + ;; Write something into a single-channel stream, try to read back too much + (handler-case + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :io :if-does-not-exist :create + :if-exists :supersede) + (write-char #\x s) + (file-position s :start) + (read-char s) + (read-char s) + nil) + (end-of-file () t)) t) (deftest write-read-unflushed-sc-3 - (let ((file (merge-pathnames #p"test-data.txt" *test-path*)) - (result t)) - (with-test-file (s file :class 'file-simple-stream :direction :io + ;; Test writing in a buffer filled with previous file contents + (let ((result t)) + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io :if-exists :overwrite :if-does-not-exist :create :initial-content *dumb-string*) - (setq result (and result (char= (read-char s) (char *dumb-string* 0)))) + (setq result (and result (char= (read-char s) (schar *dumb-string* 0)))) (setq result (and result (= (file-position s) 1))) (let ((pos (file-position s))) (write-char #\x s) @@ -271,8 +275,8 @@ (deftest write-read-unflushed-sc-4 ;; Test flushing of buffers - (let ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :io + (progn + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io :if-exists :overwrite :if-does-not-exist :create :initial-content "Foo" :delete-afterwards nil) @@ -281,16 +285,16 @@ (write-char #\X s) (file-position s :end) ; Extend file. (write-char #\X s)) - (with-test-file (s file :class 'file-simple-stream :direction :input - :if-does-not-exist :error) + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :input :if-does-not-exist :error) (read-line s))) "XooX" T) (deftest write-read-append-sc-1 ;; Test writing in the middle of a stream opened in append mode - (let ((file (merge-pathnames #p"test-data.txt" *test-path*))) - (with-test-file (s file :class 'file-simple-stream :direction :io + (progn + (with-test-file (s *test-file* :class 'file-simple-stream :direction :io :if-exists :append :if-does-not-exist :create :initial-content "Foo" :delete-afterwards nil) @@ -298,8 +302,9 @@ (write-char #\X s) (file-position s :end) ; Extend file. (write-char #\X s)) - (with-test-file (s file :class 'file-simple-stream :direction :input - :if-does-not-exist :error) + (with-test-file (s *test-file* :class 'file-simple-stream + :direction :input :if-does-not-exist :error) (read-line s))) "XooX" T) + diff --git a/contrib/sb-simple-streams/strategy.lisp b/contrib/sb-simple-streams/strategy.lisp index ebbddf3..b080292 100644 --- a/contrib/sb-simple-streams/strategy.lisp +++ b/contrib/sb-simple-streams/strategy.lisp @@ -17,6 +17,7 @@ ;;;; Helper functions (defun refill-buffer (stream blocking) + (declare (type blocking blocking)) (with-stream-class (simple-stream stream) (let* ((unread (sm last-char-read-size stream)) (buffer (sm buffer stream)) @@ -140,7 +141,8 @@ (state (sm oc-state stream))) (flet ((input () (when (>= buffpos (sm buffer-ptr stream)) - (when (sc-dirty-p stream) + (when (and (not (any-stream-instance-flags stream :dual :string)) + (sc-dirty-p stream)) (flush-buffer stream t)) (let ((bytes (refill-buffer stream blocking))) (cond ((= bytes 0) @@ -216,7 +218,8 @@ (type boolean blocking) #|(optimize (speed 3) (space 2) (safety 0) (debug 0))|#) (with-stream-class (simple-stream stream) - (when (sc-dirty-p stream) + (when (and (not (any-stream-instance-flags stream :dual :string)) + (sc-dirty-p stream)) (flush-buffer stream t)) (do ((buffer (sm buffer stream)) (buffpos (sm buffpos stream)) diff --git a/version.lisp-expr b/version.lisp-expr index 04cb12d..0e9f387 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.92" +"0.8.3.93" -- 1.7.10.4