Add tests for extended in-flvector and in-fxvector forms, refactoring common code to for-util.rkt
This commit is contained in:
Noel Welsh
parent
319ea7ea00
commit
899e31e2ce
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
102
collects/tests/racket/for-util.rkt
Normal file
102
collects/tests/racket/for-util.rkt
Normal file
|
|
@ -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)]))
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user