added simple regression test for guardians.
This commit is contained in:
parent
e315324cbf
commit
279618fde2
|
@ -1 +1 @@
|
||||||
1712
|
1713
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
lists strings bytevectors hashtables fixnums bignums numerics
|
lists strings bytevectors hashtables fixnums bignums numerics
|
||||||
bitwise enums pointers sorting io fasl reader case-folding
|
bitwise enums pointers sorting io fasl reader case-folding
|
||||||
parse-flonums string-to-number bignum-to-flonum div-and-mod
|
parse-flonums string-to-number bignum-to-flonum div-and-mod
|
||||||
fldiv-and-mod unicode normalization repl set-position))
|
fldiv-and-mod unicode normalization repl set-position guardians))
|
||||||
|
|
||||||
(define (run-test-from-library x)
|
(define (run-test-from-library x)
|
||||||
(printf "[testing ~a] ..." x)
|
(printf "[testing ~a] ..." x)
|
||||||
|
|
|
@ -0,0 +1,36 @@
|
||||||
|
|
||||||
|
(library (tests guardians)
|
||||||
|
(export run-tests)
|
||||||
|
(import (ikarus))
|
||||||
|
|
||||||
|
(define (test1)
|
||||||
|
(define (for-each-pair f x)
|
||||||
|
(when (pair? x)
|
||||||
|
(f x)
|
||||||
|
(for-each-pair f (cdr x))))
|
||||||
|
|
||||||
|
(define n 100)
|
||||||
|
|
||||||
|
(define ls (make-list n))
|
||||||
|
|
||||||
|
(define g (make-guardian))
|
||||||
|
|
||||||
|
(for-each-pair g ls)
|
||||||
|
|
||||||
|
(set! ls (cdr ls))
|
||||||
|
|
||||||
|
(let f ([i 1])
|
||||||
|
(unless (= i n)
|
||||||
|
(collect)
|
||||||
|
(cond
|
||||||
|
[(g) =>
|
||||||
|
(lambda (p)
|
||||||
|
(assert (eq? (cdr p) ls))
|
||||||
|
(set! ls (cdr ls))
|
||||||
|
(f (+ i 1)))]
|
||||||
|
[else (f i)])))
|
||||||
|
(assert (null? ls)))
|
||||||
|
|
||||||
|
(define (run-tests)
|
||||||
|
(test1)))
|
||||||
|
|
Loading…
Reference in New Issue