From cf47297a078e1dd9f30919c7a34ce5024fe1df80 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sun, 5 Sep 2010 01:30:53 -0600 Subject: [PATCH] gvector tests, fixed bugs, added for/gvector docs --- collects/data/gvector.rkt | 35 ++++++- collects/data/scribblings/gvector.scrbl | 15 +++ collects/tests/data/gvector.rkt | 125 ++++++++++++++++++++++++ 3 files changed, 170 insertions(+), 5 deletions(-) create mode 100644 collects/tests/data/gvector.rkt diff --git a/collects/data/gvector.rkt b/collects/data/gvector.rkt index a7843d1649..e856169a89 100644 --- a/collects/data/gvector.rkt +++ b/collects/data/gvector.rkt @@ -149,16 +149,20 @@ (syntax-case stx () [(_ (clause ...) . body) (quasisyntax/loc stx - (let ([gv (make-gvector)]) - (for/fold/derived #,stx () (clause ...) . body) + (let ([gv (make-gvector*)]) + (for/fold/derived #,stx () (clause ...) + (call-with-values (lambda () . body) + (lambda args (apply gvector-add! gv args) (values)))) gv))])) (define-syntax (for*/gvector stx) (syntax-case stx () [(_ (clause ...) . body) (quasisyntax/loc stx - (let ([gv (make-gvector)]) - (for*/fold/derived #,stx () (clause ...) . body) + (let ([gv (make-gvector*)]) + (for*/fold/derived #,stx () (clause ...) + (call-with-values (lambda () . body) + (lambda args (apply gvector-add! gv args) (values)))) gv))])) (define-struct gvector (vec n) @@ -174,6 +178,25 @@ gvector-iterate-next gvector-iterate-key gvector-iterate-value) + #:property prop:equal+hash + (let ([equals + (lambda (x y recursive-equal?) + (let ([vx (gvector-vec x)] + [vy (gvector-vec y)] + [nx (gvector-n x)] + [ny (gvector-n y)]) + (and (= nx ny) + (for/and ([index (in-range nx)]) + (recursive-equal? (vector-ref vx index) + (vector-ref vy index))))))] + [hash-code + (lambda (x hc) + (let ([v (gvector-vec x)] + [n (gvector-n x)]) + (for/fold ([h 1]) ([i (in-range n)]) + ;; FIXME: better way of combining hashcodes + (+ h (hc (vector-ref v i))))))]) + (list equals hash-code hash-code)) #:property prop:sequence in-gvector) (provide/contract @@ -196,4 +219,6 @@ [gvector->vector (-> gvector? vector?)]) -(provide (rename-out [in-gvector* in-gvector])) +(provide (rename-out [in-gvector* in-gvector]) + for/gvector + for*/gvector) diff --git a/collects/data/scribblings/gvector.scrbl b/collects/data/scribblings/gvector.scrbl index bd5fa8ccf4..34ae36be62 100644 --- a/collects/data/scribblings/gvector.scrbl +++ b/collects/data/scribblings/gvector.scrbl @@ -23,6 +23,9 @@ be extended by adding an element to the end, and it can be shrunk by removing any element, although removal can take time linear in the number of elements in the gvector. +Two gvectors are @racket[equal?] if they contain the same number of +elements and if the contain equal elements at each index. + @defproc[(make-gvector [#:capacity capacity exact-positive-integer? 10]) gvector?]{ @@ -102,3 +105,15 @@ changes the elements produced by the sequence. To obtain a sequence from a snapshot of @racket[gv], use @racket[(in-vector (gvector->vector gv))] instead. } + +@deftogether[[ +@defform[(for/gvector (for-clause ...) body ...+)] +@defform[(for*/gvector (for-clause ...) body ...+)]]]{ + +Analogous to @racket[for/list] and @racket[for*/list], but constructs +a gvector instead of a list. + +Unlike @racket[for/list], the @racket[body] may return zero or +multiple values; all returned values are added to the gvector, in +order, on each iteration. +} diff --git a/collects/tests/data/gvector.rkt b/collects/tests/data/gvector.rkt new file mode 100644 index 0000000000..1b2591d32f --- /dev/null +++ b/collects/tests/data/gvector.rkt @@ -0,0 +1,125 @@ +#lang racket/base +(require data/gvector + racket/dict + rackunit) + +(test-equal? "gvector" + (gvector->vector (gvector 1 2 3)) + '#(1 2 3)) + +(test-equal? "gvector-add! (one)" + (gvector->vector + (let ([gv (make-gvector)]) + (for ([x '(1 2 3)]) + (gvector-add! gv x)) + gv)) + '#(1 2 3)) + +(test-equal? "gvector-add! (multi)" + (gvector->vector + (let ([gv (make-gvector)]) + (gvector-add! gv 1 2 3) + gv)) + '#(1 2 3)) + +(test-equal? "gvector-ref" + (let ([gv (gvector 1 2 3)]) + ;; 3 valid refs + 1 not-found + (for/list ([index '(0 1 2 3)]) + (gvector-ref gv index #f))) + '(1 2 3 #f)) + +(test-equal? "gvector-set! (in range)" + (let ([gv (gvector 1 2 3)]) + (gvector-set! gv 1 'apple) + (gvector->vector gv)) + '#(1 apple 3)) + +(test-equal? "gvector-set! as add" + (let ([gv (gvector 1 2 3)]) + (gvector-set! gv 3 4) + (gvector->vector gv)) + '#(1 2 3 4)) + +(test-equal? "gvector-remove! at end" + (let ([gv (gvector 1 2 3)]) + (gvector-remove! gv 2) + (gvector->vector gv)) + '#(1 2)) + +(test-equal? "gvector-remove! at beginning" + (let ([gv (gvector 1 2 3)]) + (gvector-remove! gv 0) + (gvector->vector gv)) + '#(2 3)) + +(test-equal? "gvector-count" + (gvector-count (gvector 1 2 3)) + 3) + +(test-equal? "gvector-count / add" + (let ([gv (gvector 1 2 3)]) + (gvector-add! gv 4 5 6) + (gvector-count gv)) + 6) + +(test-equal? "in-gvector" + (let ([gv (gvector 1 2 3)]) + (for/list ([x (in-gvector gv)]) x)) + '(1 2 3)) + +(test-equal? "gvector as sequence" + (let ([gv (gvector 1 2 3)]) + (for/list ([x gv]) x)) + '(1 2 3)) + +(test-equal? "for/gvector" + (gvector->vector (for/gvector ([x '(1 2 3)]) x)) + '#(1 2 3)) + +(test-case "gvector, lots of adds" + (let ([gv (make-gvector)]) + (for ([x (in-range 0 1000)]) + (gvector-add! gv x)) + (for ([x (in-range 0 1000)]) + (check-equal? (gvector-ref gv x) x)) + (check-equal? (gvector-count gv) 1000))) + +(test-equal? "gvector, dict-map" + (dict-map (gvector 1 2 3) list) + '((0 1) (1 2) (2 3))) +(test-equal? "gvector, dict-ref" + (dict-ref (gvector 1 2 3) 0) + 1) + +(test-equal? "gvector, dict-ref out of range" + (dict-ref (gvector 1 2 3) 5 #f) + #f) + +(test-equal? "gvector, equals, empty" + (gvector) + (make-gvector #:capacity 50)) + +(test-case "gvector, equals" + (let ([g1 (make-gvector)] + [g2 (make-gvector)]) + (for ([x (in-range 1000)]) + (check-equal? g1 g2) + (check-equal? (equal-hash-code g1) (equal-hash-code g2)) + (gvector-add! g1 x) + (gvector-add! g2 x)))) + +(test-case "gvector, equals, w cycles" + (let ([g1 (make-gvector)] + [g2 (make-gvector)]) + (for ([x (in-range 10)]) + (check-equal? g1 g2) + (check-equal? (equal-hash-code g1) (equal-hash-code g2)) + (gvector-add! g1 (if (zero? (modulo x 2)) g1 g2)) + (gvector-add! g2 (if (zero? (modulo x 3)) g1 g2))))) + +(test-case "gvector, not equal, same length" + (check-not-equal? (gvector 1) (gvector 2))) + +(test-case "gvector, not equal, extension" + (check-not-equal? (gvector 1) (gvector 1 2)))