guile-rsv

commit 68837a803097567f1739c045745aeb08c93ae0dd
parent ecf0cbd486bb5f73e335e9e04212b0985f3efc35
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Sun, 21 Jan 2024 15:18:24 +0200

Add two new procedures and their tests.  rsv-bytevector->scm and scm->rsv-bytevector.  Bump version number.

Diffstat:
M
rsv.scm
 | 
19
+++++++++++++++----
M
rsv/version.scm
 | 
2
+-
M
tests.scm
 | 
28
+++++++++++++++++++---------

3 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/rsv.scm b/rsv.scm
@@ -18,11 +18,13 @@
   (import (scheme base)
           (scheme file)
           (scheme write))
-  (export write-rsv
-          write-rsv-row
+  (export legal-rsv?
           read-rsv
           read-rsv-row
-          legal-rsv?)
+          rsv-bytevector->scm
+          scm->rsv-bytevector
+          write-rsv
+          write-rsv-row)
 
   (begin
     (define row-terminator-byte #xFD)   ;; 253
@@ -80,6 +82,11 @@ Null-Value := #f"
             (write-rsv-row row port)
             (loop rest-of-rows))))))
 
+    (define (scm->rsv-bytevector scm)
+      (let ((output-bytevector-port (open-output-bytevector)))
+        (write-rsv scm output-bytevector-port)
+        (get-output-bytevector output-bytevector-port)))
+
     (define (legal-utf8? byte)
       ;; XXX: Replace with a better predicate.
       (and (integer? byte)
@@ -238,4 +245,8 @@ read."
            (else
             (error "Illegal value returned when reading RSV row: (illegal value, row)"
                    byte
-                   row-count))))))))
+                   row-count))))))
+
+    (define (rsv-bytevector->scm bv)
+      (let ((bytevector-input-port (open-input-bytevector bv)))
+        (read-rsv bytevector-input-port)))))
diff --git a/rsv/version.scm b/rsv/version.scm
@@ -17,4 +17,4 @@
 (define-library (rsv version)
   (import (scheme base))
   (export version)
-  (begin (define version "0.1.0")))
+  (begin (define version "0.2.0")))
diff --git a/tests.scm b/tests.scm
@@ -72,6 +72,11 @@
          (let* ((input-bytevector-port (open-input-bytevector original-rsv)))
            (test-error (cons (read-rsv input-bytevector-port)
                              original-rsv))))
+       #:count-calls? #t)
+      (statprof
+       (lambda ()
+         (test-error (cons (rsv-bytevector->scm original-rsv)
+                           original-rsv)))
        #:count-calls? #t))
 
     (define (run-back-and-forth-test original-rsv)
@@ -82,7 +87,12 @@
                 (output-bytevector-port (open-output-bytevector)))
            (write-rsv scm output-bytevector-port)
            (test-equal original-rsv
-                       (get-output-bytevector output-bytevector-port))))
+             (get-output-bytevector output-bytevector-port))))
+       #:count-calls? #t)
+      (statprof
+       (lambda ()
+         (test-equal original-rsv
+           (scm->rsv-bytevector (rsv-bytevector->scm original-rsv))))
        #:count-calls? #t))
 
     (define (scm-rows-stream->rsv stream)
@@ -109,9 +119,9 @@
                 (call-with-input-file filename
                   (lambda (port)
                     (test-group filename
-                                (let ((original-rsv (get-bytevector-all port)))
-                                  (display 'run-back-and-forth-failing-test) (newline)
-                                  (run-back-and-forth-failing-test original-rsv))))))
+                      (let ((original-rsv (get-bytevector-all port)))
+                        (display 'run-back-and-forth-failing-test) (newline)
+                        (run-back-and-forth-failing-test original-rsv))))))
               invalid-filenames)
 
     (for-each (lambda (filename)
@@ -119,11 +129,11 @@
                 (call-with-input-file filename
                   (lambda (port)
                     (test-group filename
-                                (let ((original-rsv (get-bytevector-all port)))
-                                  (display 'run-back-and-forth-test) (newline)
-                                  (run-back-and-forth-test original-rsv)
-                                  (display 'run-stream-back-and-forth-test) (newline)
-                                  (run-stream-back-and-forth-test original-rsv))))))
+                      (let ((original-rsv (get-bytevector-all port)))
+                        (display 'run-back-and-forth-test) (newline)
+                        (run-back-and-forth-test original-rsv)
+                        (display 'run-stream-back-and-forth-test) (newline)
+                        (run-stream-back-and-forth-test original-rsv))))))
               valid-filenames)
 
     (test-end "RSV")))