Re: Gathering comprehensive SRFI test suites in one place
Lassi Kortela 26 Jan 2020 20:31 UTC
> The "test" egg has sort of become the de facto default CHICKEN test egg.
Here's some code to auto-convert tests using the Chicken test egg to
SRFI 64 syntax:
(define (convert x)
(if (not (pair? x)) x
(case (car x)
((test-group)
`((test-begin ,(cadr x))
,@(map convert (cddr x))
(test-end ,(cadr x))))
((test)
`(test-equal ,@(cdr x)))
(else
x))))
(pp
(convert
'(test-group
"vectors/searching"
(test 2 (vector-index even? '#(3 1 4 1 5 9 6)))
(test 1 (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
(test #f (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
(test 5 (vector-index-right odd? '#(3 1 4 1 5 9 6)))
(test 3 (vector-index-right < '#(3 1 4 1 5) '#(2 7 1 8 2)))
(test 2 (vector-skip number? '#(1 2 a b 3 4 c d)))
(test 2 (vector-skip = '#(1 2 3 4 5) '#(1 2 -3 4)))
(test 7 (vector-skip-right number? '#(1 2 a b 3 4 c d)))
(test 3 (vector-skip-right = '#(1 2 3 4 5) '#(1 2 -3 -4 5)))
(test 0 (vector-binary-search v 0 cmp))
(test 3 (vector-binary-search v 6 cmp))
(test #f (vector-binary-search v 1 cmp))
(test-assert (vector-any number? '#(1 2 x y z)))
(test-assert (vector-any < '#(1 2 3 4 5) '#(2 1 3 4 5)))
(test #f (vector-any number? '#(a b c d e)))
(test #f (vector-any > '#(1 2 3 4 5) '#(1 2 3 4 5)))
(test #f (vector-every number? '#(1 2 x y z)))
(test-assert (vector-every number? '#(1 2 3 4 5)))
(test #f (vector-every < '#(1 2 3) '#(2 3 3)))
(test-assert (vector-every < '#(1 2 3) '#(2 3 4)))
(test 'yes (vector-any (lambda (x) (if (number? x) 'yes #f)) '#(1 2
x y z)))
(let-values (((new off) (vector-partition number? '#(1 x 2 y 3 z))))
(test '#(1 2 3 x y z) (vector-copy new))
(test 3 (+ off 0))))))
;;; Output:
((test-begin "vectors/searching")
(test-equal 2 (vector-index even? '#(3 1 4 1 5 9 6)))
(test-equal 1 (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
(test-equal #f (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
(test-equal 5 (vector-index-right odd? '#(3 1 4 1 5 9 6)))
(test-equal 3 (vector-index-right < '#(3 1 4 1 5) '#(2 7 1 8 2)))
(test-equal 2 (vector-skip number? '#(1 2 a b 3 4 c d)))
(test-equal 2 (vector-skip = '#(1 2 3 4 5) '#(1 2 -3 4)))
(test-equal 7 (vector-skip-right number? '#(1 2 a b 3 4 c d)))
(test-equal 3 (vector-skip-right = '#(1 2 3 4 5) '#(1 2 -3 -4 5)))
(test-equal 0 (vector-binary-search v 0 cmp))
(test-equal 3 (vector-binary-search v 6 cmp))
(test-equal #f (vector-binary-search v 1 cmp))
(test-assert (vector-any number? '#(1 2 x y z)))
(test-assert (vector-any < '#(1 2 3 4 5) '#(2 1 3 4 5)))
(test-equal #f (vector-any number? '#(a b c d e)))
(test-equal #f (vector-any > '#(1 2 3 4 5) '#(1 2 3 4 5)))
(test-equal #f (vector-every number? '#(1 2 x y z)))
(test-assert (vector-every number? '#(1 2 3 4 5)))
(test-equal #f (vector-every < '#(1 2 3) '#(2 3 3)))
(test-assert (vector-every < '#(1 2 3) '#(2 3 4)))
(test-equal
'yes
(vector-any (lambda (x) (if (number? x) 'yes #f)) '#(1 2 x y z)))
(let-values (((new off) (vector-partition number? '#(1 x 2 y 3 z))))
(test '#(1 2 3 x y z) (vector-copy new))
(test 3 (+ off 0)))
(test-end "vectors/searching"))