guile-rsv

R7RS Scheme library for reading and writing RSV (Rows of String Values) data format. Specified in https://github.com/Stenway/RSV-Specification and demonstrated in https://www.youtube.com/watch?v=tb_70o6ohMA
git clone https://kaka.farm/~git/guile-rsv
Log | Files | Refs | README | LICENSE

tests.scm (4568B)

      1 #!/usr/bin/env sh
      2 exec guile --r7rs -e main -L . -s "$0" "$@"
      3 !#
      4 
      5 ;;; Scheme implementation of RSV - Rows of String Values.
      6 ;;; Copyright (C) 2024  Yuval Langer.
      7 ;;;
      8 ;;; This program is free software: you can redistribute it and/or modify
      9 ;;; it under the terms of the GNU General Public License as published by
     10 ;;; the Free Software Foundation, either version 3 of the License, or
     11 ;;; (at your option) any later version.
     12 ;;;
     13 ;;; This program is distributed in the hope that it will be useful,
     14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     16 ;;; GNU General Public License for more details.
     17 ;;;
     18 ;;; You should have received a copy of the GNU General Public License
     19 ;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     20 
     21 (define-library (rsv tests)
     22   (import (scheme base)
     23           (scheme file)
     24           (scheme write)
     25 
     26           (srfi srfi-1)
     27           (srfi srfi-64)
     28 
     29           (statprof)
     30 
     31           (rsv))
     32   (export main)
     33 
     34   (begin
     35     (define valid-filenames
     36       (append (map (lambda (n)
     37                      (string-append "TestFiles/Valid_00"
     38                                     (number->string n)
     39                                     ".rsv"))
     40                    (iota 9 1))
     41               (map (lambda (n)
     42                      (string-append "TestFiles/Valid_0"
     43                                     (number->string n)
     44                                     ".rsv"))
     45                    (iota 70 10))))
     46 
     47     (define invalid-filenames
     48       (append (map (lambda (n)
     49                      (string-append "TestFiles/Invalid_00"
     50                                     (number->string n)
     51                                     ".rsv"))
     52                    (iota 9 1))
     53               (map (lambda (n)
     54                      (string-append "TestFiles/Invalid_0"
     55                                     (number->string n)
     56                                     ".rsv"))
     57                    (iota 20 10))))
     58 
     59     (define (get-bytevector-all port)
     60       (let ((output-bytevector-port (open-output-bytevector)))
     61         (let loop ()
     62           (let ((byte (read-u8 port)))
     63             (cond
     64              ((eof-object? byte)
     65               (get-output-bytevector output-bytevector-port))
     66              ((number? byte)
     67               (write-u8 byte output-bytevector-port)
     68               (loop))
     69              (else
     70               (error "Illegal value while reading file:" byte)))))))
     71 
     72     (define (run-back-and-forth-failing-test original-rsv)
     73       (statprof
     74        (lambda ()
     75          (let* ((input-bytevector-port (open-input-bytevector original-rsv)))
     76            (test-error (cons (read-rsv input-bytevector-port)
     77                              original-rsv))))
     78        #:count-calls? #t)
     79       (statprof
     80        (lambda ()
     81          (test-error (cons (rsv-bytevector->scm original-rsv)
     82                            original-rsv)))
     83        #:count-calls? #t))
     84 
     85     (define (run-back-and-forth-test original-rsv)
     86       (statprof
     87        (lambda ()
     88          (let* ((input-bytevector-port (open-input-bytevector original-rsv))
     89                 (scm (read-rsv input-bytevector-port))
     90                 (output-bytevector-port (open-output-bytevector)))
     91            (write-rsv scm output-bytevector-port)
     92            (test-equal original-rsv
     93              (get-output-bytevector output-bytevector-port))))
     94        #:count-calls? #t)
     95       (statprof
     96        (lambda ()
     97          (test-equal original-rsv
     98            (scm->rsv-bytevector (rsv-bytevector->scm original-rsv))))
     99        #:count-calls? #t))
    100 
    101     (define (main args)
    102 
    103       (test-begin "rsv-tests")
    104 
    105       (for-each (lambda (filename)
    106                   (write filename) (newline)
    107                   (call-with-input-file filename
    108                     (lambda (port)
    109                       (test-group filename
    110                         (let ((original-rsv (get-bytevector-all port)))
    111                           (display 'run-back-and-forth-failing-test) (newline)
    112                           (run-back-and-forth-failing-test original-rsv))))))
    113                 invalid-filenames)
    114 
    115       (for-each (lambda (filename)
    116                   (write filename) (newline)
    117                   (call-with-input-file filename
    118                     (lambda (port)
    119                       (test-group filename
    120                         (let ((original-rsv (get-bytevector-all port)))
    121                           (display 'run-back-and-forth-test) (newline)
    122                           (run-back-and-forth-test original-rsv))))))
    123                 valid-filenames)
    124 
    125       (test-end "rsv-tests"))))