Menu
▾
▴
[Sbcl-commits] CVS: sbcl/contrib/sb-simple-streams strategy.lisp,1.7,1.8 simple-stream-tests.lisp,1.8,1.9 internal.lisp,1.3,1.4 impl.lisp,1.1,1.2 classes.lisp,1.6,1.7 TODO,1.4,1.5
|
From: Rudi S. <ru...@us...> - 2003-09-25 12:12:27
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-simple-streams
In directory sc8-pr-cvs1:/tmp/cvs-serv21952/contrib/sb-simple-streams
Modified Files:
strategy.lisp simple-stream-tests.lisp internal.lisp impl.lisp
classes.lisp TODO
Log Message:
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)
Index: strategy.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/strategy.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- strategy.lisp 21 Sep 2003 20:01:30 -0000 1.7
+++ strategy.lisp 25 Sep 2003 12:12:10 -0000 1.8
@@ -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))
Index: simple-stream-tests.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/simple-stream-tests.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- simple-stream-tests.lisp 7 Sep 2003 14:10:26 -0000 1.8
+++ simple-stream-tests.lisp 25 Sep 2003 12:12:11 -0000 1.9
@@ -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)
+
Index: internal.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/internal.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- internal.lisp 7 Sep 2003 14:10:26 -0000 1.3
+++ internal.lisp 25 Sep 2003 12:12:11 -0000 1.4
@@ -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))
Index: impl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/impl.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- impl.lisp 7 Sep 2003 14:10:26 -0000 1.1
+++ impl.lisp 25 Sep 2003 12:12:11 -0000 1.2
@@ -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
Index: classes.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/classes.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- classes.lisp 7 Sep 2003 14:10:26 -0000 1.6
+++ classes.lisp 25 Sep 2003 12:12:11 -0000 1.7
@@ -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)
Index: TODO
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/TODO,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- TODO 7 Sep 2003 14:10:26 -0000 1.4
+++ TODO 25 Sep 2003 12:12:11 -0000 1.5
@@ -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.
|