rename check-view etc. to check-lens-view etc.

This commit is contained in:
AlexKnauth 2015-09-07 15:41:51 -04:00
parent 87d9a2a4f4
commit fdf72e24cd
5 changed files with 46 additions and 44 deletions

View File

@ -22,10 +22,10 @@
(define cdr-lens (make-lens cdr set-cdr))
(module+ test
(check-view car-lens '(1 . 2) 1)
(check-set car-lens '(1 . 2) 'a '(a . 2))
(check-lens-view car-lens '(1 . 2) 1)
(check-lens-set car-lens '(1 . 2) 'a '(a . 2))
(test-lens-laws car-lens '(1 . 2) 'a 'b)
(check-view cdr-lens '(1 . 2) 2)
(check-set cdr-lens '(1 . 2) 'a '(1 . a))
(check-lens-view cdr-lens '(1 . 2) 2)
(check-lens-set cdr-lens '(1 . 2) 'a '(1 . a))
(test-lens-laws cdr-lens '(1 . 2) 'a 'b))

View File

@ -20,7 +20,10 @@ module+ test
module+ test
(define-check (check-stream-equal? stream1 stream2)
(equal? (stream->list stream1) (stream->list stream2)))
(let ([list1 (stream->list stream1)] [list2 (stream->list stream2)])
(with-check-info
(['actual-list list1] ['expected-list list2])
(check-equal? list1 list2))))
(define (stream-ref-lens i)
@ -55,8 +58,8 @@ module+ test
(stream-cons v rst)))
module+ test
(check-equal? (lens-view stream-first-lens (stream 'a 'b 'c)) 'a)
(check-equal? (lens-view (stream-ref-lens 2) (stream 'a 'b 'c)) 'c)
(check-lens-view stream-first-lens (stream 'a 'b 'c) 'a)
(check-lens-view (stream-ref-lens 2) (stream 'a 'b 'c) 'c)
(check-stream-equal? (lens-set stream-first-lens (stream 'a 'b 'c) 1)
(stream 1 'b 'c))
(check-stream-equal? (lens-set (stream-ref-lens 2) (stream 'a 'b 'c) 1)
@ -66,10 +69,9 @@ module+ test
(apply lens-thrush (map stream-ref-lens is)))
module+ test
(check-equal? (lens-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd))
'foo)
(check-stream-equal? (lens-set (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'FOO)
(stream 'a (stream 1 2 (stream 'FOO 'bar 'baz) 3 4) 'b 'c 'd))
(check-lens-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'foo)
(check-lens-set-view (stream-ref-nested-lens 1 2 0)
(stream 'a (stream 1 2 (stream 'foo 'bar 'baz) 3 4) 'b 'c 'd)
'FOO)

View File

@ -57,6 +57,6 @@
(module+ test
(struct/lens foo (a b c d) #:transparent)
(check-view foo-b-lens (foo 1 2 3 4) 2)
(check-set foo-c-lens (foo 1 2 3 4) 'a (foo 1 2 'a 4))
(check-lens-view foo-b-lens (foo 1 2 3 4) 2)
(check-lens-set foo-c-lens (foo 1 2 3 4) 'a (foo 1 2 'a 4))
(test-lens-laws foo-a-lens (foo 1 2 3 4) 'a 'b))

View File

@ -8,40 +8,40 @@
(provide
(contract-out
[check-view (-> lens? any/c any/c void?)]
[check-set (-> lens? any/c any/c any/c void?)]
[check-view-set (-> lens? any/c void?)]
[check-set-view (-> lens? any/c any/c void?)]
[check-set-set (-> lens? any/c any/c any/c void?)]
[test-lens-laws (-> lens? any/c any/c any/c void?)]))
[check-lens-view (-> lens? any/c any/c void?)]
[check-lens-set (-> lens? any/c any/c any/c void?)]
[check-lens-view-set (-> lens? any/c void?)]
[check-lens-set-view (-> lens? any/c any/c void?)]
[check-lens-set-set (-> lens? any/c any/c any/c void?)]
[test-lens-laws (-> lens? any/c any/c any/c void?)]))
(define-check (check-view lens target expected-view)
(define-check (check-lens-view lens target expected-view)
(check-equal? (lens-view lens target) expected-view))
(define-check (check-set lens target new-view expected-new-target)
(define-check (check-lens-set lens target new-view expected-new-target)
(check-equal? (lens-set lens target new-view) expected-new-target))
(define-check (check-view-set lens target)
(check-equal? (lens-set lens target (lens-view lens target))
target
"setting target's view to its own view not equal? to itself"))
(define-check (check-lens-view-set lens target)
(check-lens-set lens target (lens-view lens target)
target
"setting target's view to its own view not equal? to itself"))
(define-check (check-set-view lens target new-view)
(check-equal? (lens-view lens (lens-set lens target new-view))
new-view
"view of target after setting it's view not equal? to the set view"))
(define-check (check-lens-set-view lens target new-view)
(check-lens-view lens (lens-set lens target new-view)
new-view
"view of target after setting it's view not equal? to the set view"))
(define-check (check-set-set lens target new-view1 new-view2)
(define-check (check-lens-set-set lens target new-view1 new-view2)
(let* ([target* (lens-set lens target new-view1)]
[target** (lens-set lens target* new-view2)])
(check-equal? (lens-view lens target**)
new-view2
"view of target after setting it's view twice not equal? to second view")))
(check-lens-view lens target**
new-view2
"view of target after setting its view twice not equal? to second view")))
(define (test-lens-laws lens test-target test-view1 test-view2)
(check-view-set lens test-target)
(check-set-view lens test-target test-view1)
(check-set-view lens test-target test-view2)
(check-set-set lens test-target test-view1 test-view2))
(check-lens-view-set lens test-target)
(check-lens-set-view lens test-target test-view1)
(check-lens-set-view lens test-target test-view2)
(check-lens-set-set lens test-target test-view1 test-view2))

View File

@ -25,10 +25,10 @@
(module+ test
(define car-lens (match-lens a (cons a b) (cons a b)))
(define cdr-lens (match-lens b (cons a b) (cons a b)))
(check-view car-lens (cons 1 2) 1)
(check-view cdr-lens (cons 1 2) 2)
(check-set car-lens (cons 1 2) 'a (cons 'a 2))
(check-set cdr-lens (cons 1 2) 'a (cons 1 'a))
(check-lens-view car-lens (cons 1 2) 1)
(check-lens-view cdr-lens (cons 1 2) 2)
(check-lens-set car-lens (cons 1 2) 'a (cons 'a 2))
(check-lens-set cdr-lens (cons 1 2) 'a (cons 1 'a))
(test-lens-laws car-lens (cons 1 2) 'a 'b)
(test-lens-laws cdr-lens (cons 1 2) 'a 'b)
)