1.18.9 Tests
This section consists of some infrastructure for maintaining tests, plus a pile of additional tests for the other functions in this document.
The test and test/set macros package up their arguments into thunks and then simply call test/proc, supplying information about the source location of the test case. The test/proc function runs the tests and reports the results.
(define-syntax (test stx) (syntax-case stx () [(_ actual expected) (with-syntax ([line (syntax-line stx)] [pos (syntax-position stx)]) #'(test/proc (λ () actual) (λ () expected) equal? line 'actual))])) (define-syntax (test/set stx) (syntax-case stx () [(_ actual expected) (with-syntax ([line (syntax-line stx)] [pos (syntax-position stx)]) #'(test/proc (λ () actual) (λ () expected) (λ (x y) (same-sets? x y)) line 'actual))])) (define test-count 0) (define (test/proc actual-thunk expected-thunk cmp line sexp) (set! test-count (+ test-count 1)) (define actual (actual-thunk)) (define expected (expected-thunk)) (unless (cmp actual expected) (error 'check-expect "test #~a~a\n ~s\n ~s\n" test-count (if line (format " on line ~a failed:" line) (format " failed: ~s" sexp)) actual expected))) (define (same-sets? l1 l2) (and (andmap (λ (e1) (member e1 l2)) l1) (andmap (λ (e2) (member e2 l1)) l2) #t)) (test (same-sets? (list) (list)) #t) (test (same-sets? (list) (list 1)) #f) (test (same-sets? (list 1) (list)) #f) (test (same-sets? (list 1 2) (list 2 1)) #t)
(test (lookup-in-table empty (make-posn 1 2)) '∞) (test (lookup-in-table (list (make-dist-cell (make-posn 1 2) 3)) (make-posn 1 2)) 3) (test (lookup-in-table (list (make-dist-cell (make-posn 2 1) 3)) (make-posn 1 2)) '∞)
(test/set (build-bfs-table (make-world (empty-board 3) (make-posn 1 1) 'playing 3 (make-posn 0 0) #f) (make-posn 1 1)) (list (make-dist-cell 'boundary 2) (make-dist-cell (make-posn 1 0) 1) (make-dist-cell (make-posn 2 0) 1) (make-dist-cell (make-posn 0 1) 1) (make-dist-cell (make-posn 1 1) 0) (make-dist-cell (make-posn 2 1) 1) (make-dist-cell (make-posn 1 2) 1) (make-dist-cell (make-posn 2 2) 1))) (test/set (build-bfs-table (make-world (list (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 0) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 0) #t) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 2 2) #t)) (make-posn 1 1) 'playing 3 (make-posn 0 0) #f) 'boundary) (list (make-dist-cell 'boundary 0))) (test/set (build-bfs-table (make-world (empty-board 5) (make-posn 2 2) 'playing 5 (make-posn 0 0) #f) 'boundary) (list (make-dist-cell 'boundary 0) (make-dist-cell (make-posn 1 0) 1) (make-dist-cell (make-posn 2 0) 1) (make-dist-cell (make-posn 3 0) 1) (make-dist-cell (make-posn 4 0) 1) (make-dist-cell (make-posn 0 1) 1) (make-dist-cell (make-posn 1 1) 2) (make-dist-cell (make-posn 2 1) 2) (make-dist-cell (make-posn 3 1) 2) (make-dist-cell (make-posn 4 1) 1) (make-dist-cell (make-posn 0 2) 1) (make-dist-cell (make-posn 1 2) 2) (make-dist-cell (make-posn 2 2) 3) (make-dist-cell (make-posn 3 2) 2) (make-dist-cell (make-posn 4 2) 1) (make-dist-cell (make-posn 0 3) 1) (make-dist-cell (make-posn 1 3) 2) (make-dist-cell (make-posn 2 3) 2) (make-dist-cell (make-posn 3 3) 2) (make-dist-cell (make-posn 4 3) 1) (make-dist-cell (make-posn 1 4) 1) (make-dist-cell (make-posn 2 4) 1) (make-dist-cell (make-posn 3 4) 1) (make-dist-cell (make-posn 4 4) 1))) (test/set (build-bfs-table (make-world (block-cell (make-posn 4 2) (empty-board 5)) (make-posn 2 2) 'playing 5 (make-posn 0 0) #f) 'boundary) (list (make-dist-cell 'boundary 0) (make-dist-cell (make-posn 1 0) 1) (make-dist-cell (make-posn 2 0) 1) (make-dist-cell (make-posn 3 0) 1) (make-dist-cell (make-posn 4 0) 1) (make-dist-cell (make-posn 0 1) 1) (make-dist-cell (make-posn 1 1) 2) (make-dist-cell (make-posn 2 1) 2) (make-dist-cell (make-posn 3 1) 2) (make-dist-cell (make-posn 4 1) 1) (make-dist-cell (make-posn 0 2) 1) (make-dist-cell (make-posn 1 2) 2) (make-dist-cell (make-posn 2 2) 3) (make-dist-cell (make-posn 3 2) 3) (make-dist-cell (make-posn 0 3) 1) (make-dist-cell (make-posn 1 3) 2) (make-dist-cell (make-posn 2 3) 2) (make-dist-cell (make-posn 3 3) 2) (make-dist-cell (make-posn 4 3) 1) (make-dist-cell (make-posn 1 4) 1) (make-dist-cell (make-posn 2 4) 1) (make-dist-cell (make-posn 3 4) 1) (make-dist-cell (make-posn 4 4) 1))) (test/set (build-bfs-table (make-world (empty-board 5) (make-posn 2 2) 'playing 5 (make-posn 0 0) #f) (make-posn 2 2)) (list (make-dist-cell 'boundary 3) (make-dist-cell (make-posn 1 0) 2) (make-dist-cell (make-posn 2 0) 2) (make-dist-cell (make-posn 3 0) 2) (make-dist-cell (make-posn 4 0) 3) (make-dist-cell (make-posn 0 1) 2) (make-dist-cell (make-posn 1 1) 1) (make-dist-cell (make-posn 2 1) 1) (make-dist-cell (make-posn 3 1) 2) (make-dist-cell (make-posn 4 1) 3) (make-dist-cell (make-posn 0 2) 2) (make-dist-cell (make-posn 1 2) 1) (make-dist-cell (make-posn 2 2) 0) (make-dist-cell (make-posn 3 2) 1) (make-dist-cell (make-posn 4 2) 2) (make-dist-cell (make-posn 0 3) 2) (make-dist-cell (make-posn 1 3) 1) (make-dist-cell (make-posn 2 3) 1) (make-dist-cell (make-posn 3 3) 2) (make-dist-cell (make-posn 4 3) 3) (make-dist-cell (make-posn 1 4) 2) (make-dist-cell (make-posn 2 4) 2) (make-dist-cell (make-posn 3 4) 2) (make-dist-cell (make-posn 4 4) 3))) (test (lookup-in-table (build-bfs-table (make-world (empty-board 5) (make-posn 2 2) 'playing 5 (make-posn 0 0) #f) (make-posn 2 2)) (make-posn 1 4)) 2)
(test ((neighbors (empty-world 11)) (make-posn 1 1)) (adjacent (make-posn 1 1))) (test ((neighbors (empty-world 11)) (make-posn 2 2)) (adjacent (make-posn 2 2))) (test ((neighbors (empty-world 3)) 'boundary) (list (make-posn 0 1) (make-posn 1 0) (make-posn 1 2) (make-posn 2 0) (make-posn 2 1) (make-posn 2 2))) (test ((neighbors (make-world (list (make-cell (make-posn 0 1) #f) (make-cell (make-posn 1 0) #f) (make-cell (make-posn 1 1) #t) (make-cell (make-posn 1 2) #f) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 2 1) #f) (make-cell (make-posn 2 2) #f)) (make-posn 1 1) 'playing 3 (make-posn 0 0) #f)) (make-posn 1 1)) '()) (test ((neighbors (make-world (list (make-cell (make-posn 0 1) #f) (make-cell (make-posn 1 0) #f) (make-cell (make-posn 1 1) #t) (make-cell (make-posn 1 2) #f) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 2 1) #f) (make-cell (make-posn 2 2) #f)) (make-posn 1 1) 'playing 3 (make-posn 0 0) #f)) (make-posn 1 0)) (list 'boundary (make-posn 2 0) (make-posn 0 1)))
<adjacent-tests> ::=
(test (adjacent (make-posn 1 1)) (list (make-posn 1 0) (make-posn 2 0) (make-posn 0 1) (make-posn 2 1) (make-posn 1 2) (make-posn 2 2))) (test (adjacent (make-posn 2 2)) (list (make-posn 1 1) (make-posn 2 1) (make-posn 1 2) (make-posn 3 2) (make-posn 1 3) (make-posn 2 3)))
(test (on-boundary? (make-posn 0 1) 13) #t) (test (on-boundary? (make-posn 1 0) 13) #t) (test (on-boundary? (make-posn 12 1) 13) #t) (test (on-boundary? (make-posn 1 12) 13) #t) (test (on-boundary? (make-posn 1 1) 13) #f) (test (on-boundary? (make-posn 10 10) 13) #f)
(test (in-bounds? (make-posn 0 0) 11) #f) (test (in-bounds? (make-posn 0 1) 11) #t) (test (in-bounds? (make-posn 1 0) 11) #t) (test (in-bounds? (make-posn 10 10) 11) #t) (test (in-bounds? (make-posn 0 -1) 11) #f) (test (in-bounds? (make-posn -1 0) 11) #f) (test (in-bounds? (make-posn 0 11) 11) #f) (test (in-bounds? (make-posn 11 0) 11) #f) (test (in-bounds? (make-posn 10 0) 11) #t) (test (in-bounds? (make-posn 0 10) 11) #f)
(test ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5 (make-posn 0 0) #t)) (make-posn 1 0)) #t) (test ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5 (make-posn 0 0) #f)) (make-posn 1 0)) #f) (test ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5 (make-posn 0 0) #t)) (make-posn 2 1)) #f) (test ((on-cats-path? (make-world (list (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 0) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 0) #t) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 2 2) #t)) (make-posn 1 1) 'cat-lost 3 (make-posn 0 0) #t)) (make-posn 0 1)) #f)
<+/f-tests> ::=
(test (+/f '∞ '∞) '∞) (test (+/f '∞ 1) '∞) (test (+/f 1 '∞) '∞) (test (+/f 1 2) 3)
(test (world-width 3) 150) (test (world-height 3) 117)
(test (cell-center-x (make-posn 0 0)) circle-radius) (test (cell-center-x (make-posn 1 0)) (+ (* 2 circle-spacing) circle-radius)) (test (cell-center-x (make-posn 1 1)) (+ (* 3 circle-spacing) circle-radius))
<clack-tests> ::=
(test (clack (make-world '() (make-posn 0 0) 'playing 3 #f #f) 1 1 "button-down") (make-world '() (make-posn 0 0) 'playing 3 #f #f)) (test (clack (make-world '() (make-posn 0 0) 'playing 3 #f #f) 1 1 'drag) (make-world '() (make-posn 0 0) 'playing 3 #f #f)) (test (clack (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 #f #f) (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0)) 'move) (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 (make-posn 0 0) #f)) (test (clack (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 #f #f) (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0)) 'enter) (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 (make-posn 0 0) #f)) (test (clack (make-world '() (make-posn 0 0) 'playing 3 (make-posn 0 0) #f) 1 1 'leave) (make-world '() (make-posn 0 0) 'playing 3 #f #f)) (test (clack (make-world '() (make-posn 0 0) 'playing 3 (make-posn 0 0) #f) 10 10 "button-down") (make-world '() (make-posn 0 0) 'playing 3 #f #f)) (test (clack (make-world (list (make-cell (make-posn 0 0) #f) (make-cell (make-posn 1 1) #f)) (make-posn 1 1) 'playing 3 (make-posn 0 0) #f) (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0)) "button-up") (make-world (list (make-cell (make-posn 0 0) #t) (make-cell (make-posn 1 1) #f)) (make-posn 1 1) 'cat-lost 3 #f #f)) (test (clack (make-world '() (make-posn 0 0) 'cat-lost 3 (make-posn 0 0) #f) 10 10 "button-up") (make-world '() (make-posn 0 0) 'cat-lost 3 #f #f)) (test (clack (make-world (list (make-cell (make-posn 1 0) #f) (make-cell (make-posn 2 0) #t) (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #t)) (make-posn 1 1) 'playing 3 #f #f) (cell-center-x (make-posn 1 0)) (cell-center-y (make-posn 1 0)) "button-up") (make-world (list (make-cell (make-posn 1 0) #t) (make-cell (make-posn 2 0) #t) (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #t)) (make-posn 1 1) 'cat-lost 3 #f #f)) (test (clack (make-world (list (make-cell (make-posn 1 0) #f) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #t)) (make-posn 1 1) 'playing 3 #f #f) (cell-center-x (make-posn 1 0)) (cell-center-y (make-posn 1 0)) "button-up") (make-world (list (make-cell (make-posn 1 0) #t) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 0 1) #t) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #t)) (make-posn 2 0) 'cat-won 3 #f #f))
(test (update-world-posn (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 #f #f) (make-posn (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0)))) (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 (make-posn 0 0) #f)) (test (update-world-posn (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 0) 'playing 3 #f #f) (make-posn (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0)))) (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 0) 'playing 3 #f #f)) (test (update-world-posn (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 (make-posn 0 0) #f) (make-posn 0 0)) (make-world (list (make-cell (make-posn 0 0) #f)) (make-posn 0 1) 'playing 3 #f #f))
<move-cat-tests> ::=
(test (move-cat (make-world (list (make-cell (make-posn 1 0) #f) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 3 0) #f) (make-cell (make-posn 4 0) #f) (make-cell (make-posn 0 1) #f) (make-cell (make-posn 1 1) #t) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 3 1) #f) (make-cell (make-posn 4 1) #f) (make-cell (make-posn 0 2) #f) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #f) (make-cell (make-posn 3 2) #t) (make-cell (make-posn 4 2) #f) (make-cell (make-posn 0 3) #f) (make-cell (make-posn 1 3) #t) (make-cell (make-posn 2 3) #f) (make-cell (make-posn 3 3) #f) (make-cell (make-posn 4 3) #f) (make-cell (make-posn 1 4) #f) (make-cell (make-posn 2 4) #f) (make-cell (make-posn 3 4) #f) (make-cell (make-posn 4 4) #f)) (make-posn 2 2) 'playing 5 (make-posn 0 0) #f)) (make-world (list (make-cell (make-posn 1 0) #f) (make-cell (make-posn 2 0) #f) (make-cell (make-posn 3 0) #f) (make-cell (make-posn 4 0) #f) (make-cell (make-posn 0 1) #f) (make-cell (make-posn 1 1) #t) (make-cell (make-posn 2 1) #t) (make-cell (make-posn 3 1) #f) (make-cell (make-posn 4 1) #f) (make-cell (make-posn 0 2) #f) (make-cell (make-posn 1 2) #t) (make-cell (make-posn 2 2) #f) (make-cell (make-posn 3 2) #t) (make-cell (make-posn 4 2) #f) (make-cell (make-posn 0 3) #f) (make-cell (make-posn 1 3) #t) (make-cell (make-posn 2 3) #f) (make-cell (make-posn 3 3) #f) (make-cell (make-posn 4 3) #f) (make-cell (make-posn 1 4) #f) (make-cell (make-posn 2 4) #f) (make-cell (make-posn 3 4) #f) (make-cell (make-posn 4 4) #f)) (make-posn 2 3) 'playing 5 (make-posn 0 0) #f))
<change-tests> ::=
(test (change (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #f) "h") (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #t)) (test (change (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #t) "h") (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #f)) (test (change (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #f) "n") (make-world '() (make-posn 1 1) 'playing 3 (make-posn 0 0) #f)) (test (world-state (change (make-world '() (make-posn 1 1) 'cat-lost 3 (make-posn 0 0) #f) "n")) 'playing)
(test (point-in-this-circle? (make-posn 0 0) (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0))) #t) (test (point-in-this-circle? (make-posn 0 0) 0 0) #f)
(test (find-best-positions (list (make-posn 0 0)) (list 1)) (list (make-posn 0 0))) (test (find-best-positions (list (make-posn 0 0)) (list '∞)) #f) (test (find-best-positions (list (make-posn 0 0) (make-posn 1 1)) (list 1 2)) (list (make-posn 0 0))) (test (find-best-positions (list (make-posn 0 0) (make-posn 1 1)) (list 1 1)) (list (make-posn 0 0) (make-posn 1 1))) (test (find-best-positions (list (make-posn 0 0) (make-posn 1 1)) (list '∞ 2)) (list (make-posn 1 1))) (test (find-best-positions (list (make-posn 0 0) (make-posn 1 1)) (list '∞ '∞)) #f)
<lt/f-tests> ::=
(test (<=/f 1 2) #t) (test (<=/f 2 1) #f) (test (<=/f '∞ 1) #f) (test (<=/f 1 '∞) #t) (test (<=/f '∞ '∞) #t)
(test (circle-at-point empty 0 0) #f) (test (circle-at-point (list (make-cell (make-posn 0 0) #f)) (cell-center-x (make-posn 0 0)) (cell-center-y (make-posn 0 0))) (make-posn 0 0)) (test (circle-at-point (list (make-cell (make-posn 0 0) #f) (make-cell (make-posn 0 1) #f)) (cell-center-x (make-posn 0 1)) (cell-center-y (make-posn 0 1))) (make-posn 0 1)) (test (circle-at-point (list (make-cell (make-posn 0 0) #f)) 0 0) #f)
(test (block-cell (make-posn 1 1) (list (make-cell (make-posn 0 0) #f) (make-cell (make-posn 1 1) #f) (make-cell (make-posn 2 2) #f))) (list (make-cell (make-posn 0 0) #f) (make-cell (make-posn 1 1) #t) (make-cell (make-posn 2 2) #f))) (test (add-n-random-blocked-cells 0 (list (make-cell (make-posn 0 0) #t)) 3) (list (make-cell (make-posn 0 0) #t))) (test (add-n-random-blocked-cells 1 (list (make-cell (make-posn 0 0) #f)) 3) (list (make-cell (make-posn 0 0) #t)))