Commit 2c470c1e authored by Erick's avatar Erick

Added R7RS primitive write-bytevector

parent 715a8b8a
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 5-Aug-2018 18:16 (eg)
;; Last file update: 5-Aug-2018 19:25 (eg)
;;
;; ======================================================================
......@@ -617,6 +617,8 @@ be accessed as a normal port with the standard Scheme primitives.])
(insertdoc 'write-with-shared-structure)
(insertdoc 'display)
(insertdoc 'newline)
(insertdoc 'write-u8)
(insertdoc 'writ-bytevector)
(insertdoc 'write-char)
(insertdoc 'write-chars)
(insertdoc 'write-byte)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 19:36 (eg)
;;;; Last file update: 3-Aug-2018 19:27 (eg)
;;;; Last file update: 5-Aug-2018 19:36 (eg)
;;;;
;;;; ----------------------------------------------------------------------
......@@ -810,3 +810,44 @@ doc>
(unless end?
(set! end (bytevector-length bv)))
(%read-bytevector! bv port start end)))
#|
<doc R7RS write-u8
* (write-u8 byte)
* (write-u8 byte port)
*
* Writes the |byte| to the given binary output port.
doc>
|#
(define (write-u8 byte :optional (port (current-output-port)))
(%claim-error
'write-u8
(unless (binary-port? port)
(error "bad binary port ~S" port))
(write-byte byte port)))
#|
<doc R7RS write-bytevector
* (write-bytevector bytevector)
* (write-bytevector bytevector port)
* (write-bytevector bytevector port start)
* (write-bytevector bytevector port start end)
*
* Writes the bytes of |bytevector| from |start| to |end| in
* left-to-right order to the binary output |port|.
doc>
|#
(define (write-bytevector bv :optional (port (current-output-port))
(start 0)
(end -1 end?))
(%claim-error
'write-bytevector
(unless (bytevector? bv) (error "bad bytevector ~S" bv))
(unless (binary-port? port) (error "bad binary port ~S" port))
(unless end? (set! end (bytevector-length bv)))
(let Loop ((i start))
(when (< i end)
(write-byte (bytevector-u8-ref bv i) port)
(Loop (+ i 1))))))
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 5-Aug-2018 18:38 (eg)
;;;; Last file update: 5-Aug-2018 19:40 (eg)
;;;;
(require "test")
......@@ -527,4 +527,47 @@
(read-bytevector! bv (open-input-bytevector #u8(0 1 2 3 4)) 3 4)
bv))
;; --------------------------------------------------
(let ((p (open-output-bytevector)))
(test "write-u8.1"
#u8(1 2)
(begin
(write-u8 1 p)
(write-u8 2 p)
(get-output-bytevector p)))
(test "write-u8.2"
#u8(1 2 3 4)
(begin
(write-byte 3 p)
(write-byte 4 p)
(get-output-bytevector p))))
;; --------------------------------------------------
(test "write-bytevector!.1"
#u8(0 1 2 3 4 5 6 7 8 9)
(let ((p (open-output-bytevector)))
(write-bytevector #u8(0 1 2 3 4 5 6 7 8 9) p)
(get-output-bytevector p)))
(test "write-bytevector!.2"
#u8(5 6 7 8 9)
(let ((p (open-output-bytevector)))
(write-bytevector #u8(0 1 2 3 4 5 6 7 8 9) p 5)
(get-output-bytevector p)))
(test "write-bytevector!.3"
#u8(5 6)
(let ((p (open-output-bytevector)))
(write-bytevector #u8(0 1 2 3 4 5 6 7 8 9) p 5 7)
(get-output-bytevector p)))
;; --------------------------------------------------
(test "flush-output-port on binary port"
#u8()
(let ((p (open-output-bytevector)))
(flush-output-port p)
(get-output-bytevector p)))
(test-section-end)
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