From 899e31e2ce13f4ac0f13582fde2c80daf279bd78 Mon Sep 17 00:00:00 2001 From: Noel Welsh Date: Fri, 3 Dec 2010 14:33:38 +0000 Subject: [PATCH] Add tests for extended in-flvector and in-fxvector forms, refactoring common code to for-util.rkt --- collects/tests/racket/fixnum.rktl | 13 +++- collects/tests/racket/flonum.rktl | 15 ++++- collects/tests/racket/for-util.rkt | 102 +++++++++++++++++++++++++++++ collects/tests/racket/for.rktl | 97 +-------------------------- 4 files changed, 130 insertions(+), 97 deletions(-) create mode 100644 collects/tests/racket/for-util.rkt diff --git a/collects/tests/racket/fixnum.rktl b/collects/tests/racket/fixnum.rktl index 0c9b4f52ef..be3fd98767 100644 --- a/collects/tests/racket/fixnum.rktl +++ b/collects/tests/racket/fixnum.rktl @@ -2,7 +2,8 @@ (Section 'fixnum) (require scheme/fixnum scheme/unsafe/ops - (prefix-in r6: rnrs/arithmetic/fixnums-6)) + (prefix-in r6: rnrs/arithmetic/fixnums-6) + "for-util.rkt") (define unary-table (list (list fxnot unsafe-fxnot) @@ -221,4 +222,14 @@ ;; ---------------------------------------- +;; in-flvector tests, copied from for.rktl + +(test-generator [(1 2 3)] (in-fxvector (fxvector 1 2 3))) +(test-generator [(2 3 4)] (in-fxvector (fxvector 1 2 3 4) 1)) +(test-generator [(2 3 4)] (in-fxvector (fxvector 1 2 3 4 5) 1 4)) +(test-generator [(2 4 6)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 1 7 2)) +(test-generator [(8 6 4)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 7 1 -2)) +(test-generator [(2 4 6)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 1 6 2)) +(test-generator [(8 6 4)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 7 2 -2)) + (report-errs) diff --git a/collects/tests/racket/flonum.rktl b/collects/tests/racket/flonum.rktl index 9fda986cef..48760d1f72 100644 --- a/collects/tests/racket/flonum.rktl +++ b/collects/tests/racket/flonum.rktl @@ -2,7 +2,8 @@ (Section 'flonum) -(require racket/flonum) +(require racket/flonum + "for-util.rkt") (define (flonum-close? fl1 fl2) (<= (flabs (fl- fl1 fl2)) @@ -74,4 +75,16 @@ (test '(2.0 3.0) 'flvector-copy (for/list ([i (in-flvector (flvector-copy v 2))]) i)) (test '(2.0) 'flvector-copy (for/list ([i (in-flvector (flvector-copy v 2 3))]) i)))) +;; in-flvector tests, copied from for.rktl + +(test-generator [(1.0 2.0 3.0)] (in-flvector (flvector 1.0 2.0 3.0))) +(test-generator [(2.0 3.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0) 1)) +(test-generator [(2.0 3.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0) 1 4)) +(test-generator [(2.0 4.0 6.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 1 7 2)) +(test-generator [(8.0 6.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 7 1 -2)) +(test-generator [(2.0 4.0 6.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 1 6 2)) +(test-generator [(8.0 6.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 7 2 -2)) + + + (report-errs) \ No newline at end of file diff --git a/collects/tests/racket/for-util.rkt b/collects/tests/racket/for-util.rkt new file mode 100644 index 0000000000..c8e30c18aa --- /dev/null +++ b/collects/tests/racket/for-util.rkt @@ -0,0 +1,102 @@ +#lang racket/base + +(require (for-syntax racket/base)) + +(provide test-multi-generator + test-generator) + +;; Utilities used by various tests of sequences + +(define-syntax (test-multi-generator stx) + (syntax-case stx () + [(_ [(v ...) ...] gen) + (with-syntax ([(id ...) (generate-temporaries #'((v ...) ...))] + [(id2 ...) (generate-temporaries #'((v ...) ...))] + [((v2 ...) ...) + (apply map list (map syntax->list (syntax->list #'((v ...) ...))))]) + #'(begin + (test `((v2 ...) ...) 'gen (for/list ([(id ...) gen]) + (list id ...))) + (test-values `((v ...) ...) (lambda () + (for/lists (id2 ...) ([(id ...) gen]) + (values id ...)))) + (test #t 'gen (for/and ([(id ...) gen]) + (and (member (list id ...) `((v2 ...) ...)) #t))) + (test (list (for/last ([(id ...) gen]) + (list id ...))) + 'gen (for/and ([(id ...) gen]) + (member (list id ...) `((v2 ...) ...)))) + (test (for/first ([(id ...) gen]) + (list id ...)) + 'gen (for/or ([(id ...) gen]) + (car (member (list id ...) `((v2 ...) ...))))) + (void)))])) + +(define-syntax test-generator + (syntax-rules () + [(_ [seq] gen) ; we assume that seq has at least 2 elements, and all are unique + (begin + ;; Some tests specific to single-values: + (test `seq 'gen (for/list ([i gen]) i)) + (test `seq 'gen (for/list ([i gen][b gen]) i)) + (test `seq 'gen (for/list ([i gen][b gen]) b)) + (test `seq 'gen (for*/list ([i gen][b '(#t)]) i)) + (test (map (lambda (x) #t) `seq) 'gen (for*/list ([i gen][b '(#t)]) b)) + (test (append `seq `seq) 'gen (for*/list ([b '(#f #t)][i gen]) i)) + (test (append `seq `seq) 'gen (for/list ([b '(#f #t)] #:when #t [i gen]) i)) + (test `seq 'gen (let ([g gen]) (for/list ([i g]) i))) + (test `seq 'gen (let ([r null]) + (for ([i gen]) (set! r (cons i r))) + (reverse r))) + (test `seq 'gen (reverse (for/fold ([a null]) ([i gen]) + (cons i a)))) + (test `seq 'gen (let-values ([(more? next) (sequence-generate gen)]) + (let loop () + (if (more?) + (cons (next) (loop)) + null)))) + (test-values `(seq seq) (lambda () + (for/lists (r1 r2) ([id gen]) + (values id id)))) + (test (list (for/last ([i gen]) i)) 'gen (for/and ([i gen]) (member i `seq))) + (test `seq 'gen (for/or ([i gen]) (member i `seq))) + (test (for/first ([i gen]) i) 'gen (for/or ([i gen]) (and (member i `seq) i))) + (test #t 'gen (for/and ([(i k) (in-parallel gen `seq)]) + (equal? i k))) + (test #f 'gen (for/and ([i gen]) + (member i (cdr (reverse `seq))))) + (test #f 'gen (for/or ([i gen]) (equal? i 'something-else))) + (let ([count 0]) + (test #t 'or (for/or ([i gen]) (set! count (add1 count)) #t)) + (test 1 'count count) + (test #f 'or (for/or ([i gen]) (set! count (add1 count)) #f)) + (test (+ 1 (length `seq)) 'count count) + (set! count 0) + (let ([second (for/last ([(i pos) (in-parallel gen (in-naturals))] #:when (< pos 2)) + (set! count (add1 count)) + i)]) + (test second list-ref `seq 1) + (test 2 values count) + (for ([i gen] #:when (equal? i second)) (set! count (add1 count))) + (for* ([i gen] #:when (equal? i second)) (set! count (add1 count))) + (test 4 values count) + (for ([i (stop-before gen (lambda (x) (equal? x second)))]) (set! count (add1 count))) + (test 5 values count) + (let ([g (stop-before gen (lambda (x) (equal? x second)))]) + (for ([i g]) (set! count (add1 count)))) + (test 6 values count) + (for ([i (stop-after gen (lambda (x) (equal? x second)))]) (set! count (add1 count))) + (test 8 values count) + (let ([g (stop-after gen (lambda (x) (equal? x second)))]) + (for ([i g]) (set! count (add1 count)))) + (test 10 values count)) + (set! count 0) + (test #t 'and (for/and ([(e idx) (in-indexed gen)]) (set! count (add1 count)) (equal? idx (sub1 count)))) + (test #t 'and (let ([g (in-indexed gen)]) + (set! count 0) + (for/and ([(e idx) g]) (set! count (add1 count)) (equal? idx (sub1 count))))) + (void)) + ;; Run multi-value tests: + (test-multi-generator [seq] gen))] + [(_ seqs gen) + (test-multi-generator seqs gen)])) \ No newline at end of file diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index 378936c9e8..ae4288d5a9 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -4,101 +4,8 @@ (Section 'for) (require scheme/generator - racket/mpair) - -(define-syntax (test-multi-generator stx) - (syntax-case stx () - [(_ [(v ...) ...] gen) - (with-syntax ([(id ...) (generate-temporaries #'((v ...) ...))] - [(id2 ...) (generate-temporaries #'((v ...) ...))] - [((v2 ...) ...) - (apply map list (map syntax->list (syntax->list #'((v ...) ...))))]) - #'(begin - (test `((v2 ...) ...) 'gen (for/list ([(id ...) gen]) - (list id ...))) - (test-values `((v ...) ...) (lambda () - (for/lists (id2 ...) ([(id ...) gen]) - (values id ...)))) - (test #t 'gen (for/and ([(id ...) gen]) - (and (member (list id ...) `((v2 ...) ...)) #t))) - (test (list (for/last ([(id ...) gen]) - (list id ...))) - 'gen (for/and ([(id ...) gen]) - (member (list id ...) `((v2 ...) ...)))) - (test (for/first ([(id ...) gen]) - (list id ...)) - 'gen (for/or ([(id ...) gen]) - (car (member (list id ...) `((v2 ...) ...))))) - (void)))])) - -(define-syntax test-generator - (syntax-rules () - [(_ [seq] gen) ; we assume that seq has at least 2 elements, and all are unique - (begin - ;; Some tests specific to single-values: - (test `seq 'gen (for/list ([i gen]) i)) - (test `seq 'gen (for/list ([i gen][b gen]) i)) - (test `seq 'gen (for/list ([i gen][b gen]) b)) - (test `seq 'gen (for*/list ([i gen][b '(#t)]) i)) - (test (map (lambda (x) #t) `seq) 'gen (for*/list ([i gen][b '(#t)]) b)) - (test (append `seq `seq) 'gen (for*/list ([b '(#f #t)][i gen]) i)) - (test (append `seq `seq) 'gen (for/list ([b '(#f #t)] #:when #t [i gen]) i)) - (test `seq 'gen (let ([g gen]) (for/list ([i g]) i))) - (test `seq 'gen (let ([r null]) - (for ([i gen]) (set! r (cons i r))) - (reverse r))) - (test `seq 'gen (reverse (for/fold ([a null]) ([i gen]) - (cons i a)))) - (test `seq 'gen (let-values ([(more? next) (sequence-generate gen)]) - (let loop () - (if (more?) - (cons (next) (loop)) - null)))) - (test-values `(seq seq) (lambda () - (for/lists (r1 r2) ([id gen]) - (values id id)))) - (test (list (for/last ([i gen]) i)) 'gen (for/and ([i gen]) (member i `seq))) - (test `seq 'gen (for/or ([i gen]) (member i `seq))) - (test (for/first ([i gen]) i) 'gen (for/or ([i gen]) (and (member i `seq) i))) - (test #t 'gen (for/and ([(i k) (in-parallel gen `seq)]) - (equal? i k))) - (test #f 'gen (for/and ([i gen]) - (member i (cdr (reverse `seq))))) - (test #f 'gen (for/or ([i gen]) (equal? i 'something-else))) - (let ([count 0]) - (test #t 'or (for/or ([i gen]) (set! count (add1 count)) #t)) - (test 1 'count count) - (test #f 'or (for/or ([i gen]) (set! count (add1 count)) #f)) - (test (+ 1 (length `seq)) 'count count) - (set! count 0) - (let ([second (for/last ([(i pos) (in-parallel gen (in-naturals))] #:when (< pos 2)) - (set! count (add1 count)) - i)]) - (test second list-ref `seq 1) - (test 2 values count) - (for ([i gen] #:when (equal? i second)) (set! count (add1 count))) - (for* ([i gen] #:when (equal? i second)) (set! count (add1 count))) - (test 4 values count) - (for ([i (stop-before gen (lambda (x) (equal? x second)))]) (set! count (add1 count))) - (test 5 values count) - (let ([g (stop-before gen (lambda (x) (equal? x second)))]) - (for ([i g]) (set! count (add1 count)))) - (test 6 values count) - (for ([i (stop-after gen (lambda (x) (equal? x second)))]) (set! count (add1 count))) - (test 8 values count) - (let ([g (stop-after gen (lambda (x) (equal? x second)))]) - (for ([i g]) (set! count (add1 count)))) - (test 10 values count)) - (set! count 0) - (test #t 'and (for/and ([(e idx) (in-indexed gen)]) (set! count (add1 count)) (equal? idx (sub1 count)))) - (test #t 'and (let ([g (in-indexed gen)]) - (set! count 0) - (for/and ([(e idx) g]) (set! count (add1 count)) (equal? idx (sub1 count))))) - (void)) - ;; Run multi-value tests: - (test-multi-generator [seq] gen))] - [(_ seqs gen) - (test-multi-generator seqs gen)])) + racket/mpair + "for-util.rkt") (test-generator [(0 1 2)] (in-range 3)) (test-generator [(3 4 5)] (in-range 3 6))