added simple regression test for guardians.

This commit is contained in:
Abdulaziz Ghuloum 2008-12-10 03:03:49 -05:00
parent e315324cbf
commit 279618fde2
3 changed files with 38 additions and 2 deletions

View File

@ -1 +1 @@
1712 1713

View File

@ -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)

36
scheme/tests/guardians.ss Normal file
View File

@ -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)))