tests-rows-streams.scm (4850B)
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 rows-streams) 22 (import (scheme base) 23 (scheme file) 24 (scheme write) 25 26 (srfi srfi-1) 27 (srfi srfi-41) 28 (srfi srfi-64) 29 30 (statprof) 31 32 (rsv) 33 (rsv rows-streams)) 34 (export main) 35 36 (begin 37 (define valid-filenames 38 (append (map (lambda (n) 39 (string-append "TestFiles/Valid_00" 40 (number->string n) 41 ".rsv")) 42 (iota 9 1)) 43 (map (lambda (n) 44 (string-append "TestFiles/Valid_0" 45 (number->string n) 46 ".rsv")) 47 (iota 70 10)))) 48 49 (define invalid-filenames 50 (append (map (lambda (n) 51 (string-append "TestFiles/Invalid_00" 52 (number->string n) 53 ".rsv")) 54 (iota 9 1)) 55 (map (lambda (n) 56 (string-append "TestFiles/Invalid_0" 57 (number->string n) 58 ".rsv")) 59 (iota 20 10)))) 60 61 (define (get-bytevector-all port) 62 (let ((output-bytevector-port (open-output-bytevector))) 63 (let loop () 64 (let ((byte (read-u8 port))) 65 (cond 66 ((eof-object? byte) 67 (get-output-bytevector output-bytevector-port)) 68 ((number? byte) 69 (write-u8 byte output-bytevector-port) 70 (loop)) 71 (else 72 (error "Illegal value while reading file:" byte))))))) 73 74 (define (scm-rows-stream->rsv stream) 75 (let ((output-bytevector-port (open-output-bytevector))) 76 (let loop ((stream stream)) 77 (cond 78 ((stream-null? stream) 79 (get-output-bytevector output-bytevector-port)) 80 (else 81 (let* ((new-scm-row (stream-car stream)) 82 (new-scm-row-pretending-to-be-a-table (list new-scm-row))) 83 (write-rsv new-scm-row-pretending-to-be-a-table 84 output-bytevector-port) 85 (loop (stream-cdr stream)))))))) 86 87 (define (back-and-forth original-rsv) 88 (let* ((input-bytevector-port (open-input-bytevector original-rsv)) 89 (rows-stream (port->rsv-row-stream input-bytevector-port))) 90 (let ((regenerated-rsv (scm-rows-stream->rsv rows-stream))) 91 regenerated-rsv))) 92 93 (define (run-stream-back-and-forth-failing-test original-rsv) 94 (statprof 95 (lambda () 96 (test-error (cons (back-and-forth original-rsv) 97 original-rsv))) 98 #:count-calls? #t)) 99 100 (define (run-stream-back-and-forth-test original-rsv) 101 (statprof 102 (lambda () 103 (test-equal original-rsv (back-and-forth original-rsv))) 104 #:count-calls? #t)) 105 106 (define (main args) 107 (test-begin "rsv-rows-streams-tests") 108 109 (for-each (lambda (filename) 110 (write filename) (newline) 111 (call-with-input-file filename 112 (lambda (port) 113 (test-group filename 114 (let ((original-rsv (get-bytevector-all port))) 115 (display 'run-stream-back-and-forth-failing-test) (newline) 116 (run-stream-back-and-forth-failing-test original-rsv)))))) 117 invalid-filenames) 118 119 (for-each (lambda (filename) 120 (write filename) (newline) 121 (call-with-input-file filename 122 (lambda (port) 123 (test-group filename 124 (let ((original-rsv (get-bytevector-all port))) 125 (display 'run-stream-back-and-forth-test) (newline) 126 (run-stream-back-and-forth-test original-rsv)))))) 127 valid-filenames) 128 129 (test-end "rsv-rows-streams-tests"))))