suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #117 from jackfirth/lens-law-checks-#114

Browse Source 
Add test-lens module
This commit is contained in:
Jack Firth 2015-07-12 12:33:08 -07:00
commit e55ebf7e88
2 changed files with 55 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lens/list/car-cdr.rkt
View File

@ -7,7 +7,8 @@
(require "../base/main.rkt")
(module+ test
(require rackunit))
(require rackunit
"../test-util/test-lens.rkt"))
(define (set-car pair v)
@ -20,5 +21,10 @@
(define cdr-lens (make-lens cdr set-cdr))
(module+ test
(check-equal? (lens-view car-lens '(1 . 2)) 1)
(check-equal? (lens-view cdr-lens '(1 . 2)) 2))
(check-view car-lens '(1 . 2) 1)
(check-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))
(test-lens-laws cdr-lens '(1 . 2) 'a 'b))

46
lens/test-util/test-lens.rkt Normal file
View File

@ -0,0 +1,46 @@
#lang racket
(require rackunit
fancy-app
"../base/base.rkt"
"../base/view-set.rkt")
(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?)]))
(define-check (check-view lens target expected-view)
(check-equal? (lens-view lens target) expected-view))
(define-check (check-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-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-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")))
(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))