mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
4e5cdedc03
By convention, a library meant for testing exports "run-tests". Also by convention, assume the test for (foo bar) is (foo bar-test), keeping the test in the same directory and avoiding confusion since (chibi test) is not a test for (chibi). - Avoids the hack of "load"ing test, with resulting namespace complications. - Allows keeping tests together with the libraries. - Allows setting up test hooks before running. - Allows implicit inference of test locations when using above conventions.
74 lines
2.6 KiB
Scheme
74 lines
2.6 KiB
Scheme
(define-library (chibi tar-test)
|
|
(export run-tests)
|
|
(import (chibi)
|
|
(only (scheme base)
|
|
bytevector-append
|
|
make-bytevector
|
|
string->utf8
|
|
bytevector
|
|
open-input-bytevector
|
|
open-output-bytevector
|
|
get-output-bytevector)
|
|
(chibi tar)
|
|
(chibi test))
|
|
(begin
|
|
(define (run-tests)
|
|
(test-begin "tar")
|
|
|
|
;; Utility to flatten bytevectors, strings and individual bytes
|
|
;; (integers) into a single bytevector for generating readable test
|
|
;; data. (<byte> . <repetition>) can be used to repeat a byte.
|
|
(define (bv . args)
|
|
(apply bytevector-append
|
|
(map (lambda (x)
|
|
(cond ((string? x) (string->utf8 x))
|
|
((pair? x) (make-bytevector (cdr x) (car x)))
|
|
((integer? x) (bytevector x))
|
|
(else x)))
|
|
args)))
|
|
|
|
(let ((b (bv "foo" '(0 . 97)
|
|
"000644 " 0
|
|
"000765 " 0
|
|
"000765 " 0
|
|
"00000000016 "
|
|
"12302104616 "
|
|
"011512" 0 " "
|
|
"0"
|
|
'(0 . 100)
|
|
"ustar" 0 "00"
|
|
"bob" '(0 . 29)
|
|
"bob" '(0 . 29)
|
|
"000000 " 0
|
|
"000000 " 0
|
|
'(0 . 155)
|
|
'(0 . 12)
|
|
)))
|
|
(let ((x (read-tar (open-input-bytevector b))))
|
|
(test "foo" (tar-path x))
|
|
(test 501 (tar-uid x))
|
|
(test "bob" (tar-owner x)))
|
|
(let ((x (make-tar)))
|
|
(tar-path-set! x "bar")
|
|
(tar-mode-set! x #o644)
|
|
(tar-uid-set! x 501)
|
|
(tar-gid-set! x 502)
|
|
(tar-size-set! x 123)
|
|
(tar-time-set! x 456)
|
|
(tar-ustar-set! x "ustar")
|
|
(tar-owner-set! x "john")
|
|
(tar-group-set! x "john")
|
|
(test "bar" (tar-path x))
|
|
(test-error (tar-mode-set! x "r"))
|
|
(let ((out (open-output-bytevector)))
|
|
(write-tar x out)
|
|
(let ((bv2 (get-output-bytevector out)))
|
|
(test-assert (bytevector? bv2))
|
|
(let ((x2 (read-tar (open-input-bytevector bv2))))
|
|
(test-assert "bar" (tar-path x2))
|
|
(test-assert #o644 (tar-mode x2))
|
|
(test-assert 501 (tar-uid x2))
|
|
(test-assert 502 (tar-gid x2))
|
|
(test-assert "john" (tar-owner x2)))))))
|
|
|
|
(test-end))))
|