rename check-view etc. to check-lens-view etc.
This commit is contained in:
parent
87d9a2a4f4
commit
fdf72e24cd
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue
Block a user