Changeset 14602


Ignore:
Timestamp:
01/16/14 17:18:38 (7 years ago)
Author:
Mark Evenson
Message:

Fix gray streams for FLEXI-STREAMS.

From Theam Yang Chew, who writes on
http://article.gmane.org/gmane.lisp.armedbear.devel/3059:

Hi all,

I inadvertently discovered some bugs in the gray-streams
implementation due to a stale flexi-streams that did not get upgraded
properly.

There were quite a few things that needed tidying - the type checking
using EQ is wrong. Also, after trying to hunt around CLHS, I think
BYTE is not a CL type (though I may be mistaken). This could be a
reflection of some Corman Lisp specific feature in the past (Yes!
These bugs seem to have been around ABCL for that long!)

Some test examples (avoiding flexi-streams or other dependencies)

;; ----- setup

(require 'gray-streams)

(defclass test-gray-binary-input-stream
(gray-streams:fundamental-binary-input-stream)

())

(defclass test-gray-character-input-stream
(gray-streams:fundamental-character-input-stream)

())

(let ((bytes (list 65 66 67 68 69))

(pos -1))

(defmethod gray-streams::stream-read-byte ((stream

test-gray-binary-input-stream))

(elt bytes (mod (incf pos) 5))))

(let ((chars (list #\A #\B #\C #\D #\E))

(pos -1))

(defmethod gray-streams::stream-read-char ((stream

test-gray-character-input-stream))

(elt chars (mod (incf pos) 5))))

;; -----

(let ((s (make-instance 'test-gray-binary-input-stream)))

(loop repeat 10 collect (read-byte s)))

=> (65 66 67 68 69 65 66 67 68 69)

(let ((arr (make-array 10 :initial-element nil)))

(list (read-sequence arr

(make-instance 'test-gray-binary-input-stream)
:start 2 :end 7)

arr))

Expected (7 #(NIL NIL 65 66 67 68 69 NIL NIL NIL)), but got an error
instead, ... no applicable method...

I guess implementors of gray streams would normally define both
read-byte & read-sequence. But ABCL's default/fallback method does try
to support binary streams, it just isn't being dispatched on the right
class.

Also, read-sequence should return the "final" array index, not the
number of bytes/characters read. Similarly, write-sequence needs to do
its work, then return the sequence itself.

Attached is a patch with what I hope are the required fixes, please
review.

Two additional notes,

  1. Even after loading my proposed fixes, I'd would still get this,

which is ok, but the error message is not obvious enough. This is
actually a method not found error, not a type error. There appears
to be some type guessing going on, so perhaps the message should
indicate failure to dispatch on STREAM or similar.

(gray-streams::stream-element-type
(make-instance 'test-gray-binary-input-stream))
The value #<TEST-GRAY-BINARY-INPUT-STREAM {500BBBF9}> is not of type STREAM.

[Condition of type TYPE-ERROR]

So we just need something like this,

(defmethod gray-streams::stream-element-type ((stream
test-gray-binary-input-stream))

'(unsigned-byte 8))

  1. I also don't understand this snippet in the original code,

converting unsigned-bytes/integers (basically the wrong type) to a
character?

(#+nil ccl:int-char code-char (elt sequence n))

Of course, after patching the above, I discovered that re-compiling
flexi-streams
got rid of my particular set of problems :-)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp

    r14436 r14602  
    344344        (stream-write-char stream #\Space)))))
    345345
     346(defun basic-read-sequence (stream sequence start end
     347                            expected-element-type read-fun)
     348  (let ((element-type (stream-element-type stream)))
     349    (if (subtypep element-type expected-element-type)
     350        (dotimes (count (- end start)
     351                  ;; If (< end start), skip the dotimes body but
     352                  ;; return start
     353                  (max start end))
     354          (let ((el (funcall read-fun stream)))
     355            (when (eq el :eof)
     356              (return (+ count start)))
     357            (setf (elt sequence (+ count start)) el)))
     358        (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A"
     359               element-type))))
     360
     361(defun basic-write-sequence (stream sequence start end
     362                             expected-element-type write-fun)
     363  (let ((element-type (stream-element-type stream)))
     364    (if (subtypep element-type expected-element-type)
     365        ;; Avoid LOOP because it isn't loaded yet
     366        (do ((n start (+ n 1)))
     367            ((= n end))
     368          (funcall write-fun stream (elt sequence n)))
     369        (error "Cannot WRITE-SEQUENCE on stream of :ELEMENT-TYPE ~A"
     370               element-type)))
     371  (stream-force-output stream)
     372  sequence)
     373
    346374(defmethod stream-read-sequence ((stream  fundamental-character-input-stream)
    347375                                 sequence &optional (start 0) end)
    348   (let ((element-type (stream-element-type stream))
    349         (end (or end (length sequence)))
    350         (eof (cons nil nil)))
    351     (cond
    352      ((eq element-type 'character)
    353       (dotimes (count (- end start) (- end start))
    354         (let ((c (stream-read-char stream nil eof)))
    355           (if (eq c eof)
    356               (return (+ count start)))
    357           (setf (elt sequence (+ count start)) c))))
    358      ((or (eq element-type 'byte)
    359           (eq element-type 'unsigned-byte)
    360           (eq element-type 'signed-byte))
    361       (dotimes (count (- end start) (- end start))
    362         (let ((b (stream-read-byte stream nil eof)))
    363           (if (eq b eof)
    364               (return (+ count start)))
    365           (setf (elt sequence (+ count start)) b))))
    366      (t (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A"
    367                element-type)))))
     376  (basic-read-sequence stream sequence start (or end (length sequence))
     377                       'character #'stream-read-char))
    368378
    369379(defmethod stream-write-sequence ((stream fundamental-character-output-stream)
    370380                                  sequence &optional (start 0) end)
    371   (let ((element-type (stream-element-type stream))
    372         (end (or end (length sequence))))
    373     (if (eq element-type 'character)
    374         (do ((n start (+ n 1)))
    375             ((= n end))
    376           (stream-write-char
    377            stream
    378            (if (typep (elt sequence n) 'number)
    379                (#+nil ccl:int-char code-char (elt sequence n))
    380                (elt sequence n))))
    381         (do ((n start (+ n 1)))
    382             ((= n end))
    383           (stream-write-byte (elt sequence n) stream))))    ;; recoded to avoid LOOP, because it isn't loaded yet
    384   (stream-force-output stream))
     381  (basic-write-sequence stream sequence start (or end (length sequence))
     382                        'character #'stream-write-char))
    385383
    386384(defclass fundamental-binary-input-stream
     
    389387(defclass fundamental-binary-output-stream
    390388  (fundamental-output-stream fundamental-binary-stream))
     389
     390(defmethod stream-read-sequence ((stream fundamental-binary-input-stream)
     391                                 sequence &optional (start 0) end)
     392  (basic-read-sequence stream sequence start (or end (length sequence))
     393                       'signed-byte #'stream-read-byte))
     394
     395(defmethod stream-write-sequence ((stream fundamental-binary-output-stream)
     396                                  sequence &optional (start 0) end)
     397  (basic-write-sequence stream sequence start (or end (length sequence))
     398                        'signed-byte #'stream-write-byte))
    391399
    392400(defun decode-read-arg (arg)
Note: See TracChangeset for help on using the changeset viewer.