tests.ss
#lang scheme/base
(require "typed-tetris.ss")
(require htdp/testing)
(require lang/htdp-advanced)

"Identical blocks are equal."
(check-expect (block=? (make-block 0 0 'black)
                       (make-block 0 0 'black))
              true)

"Identical (modulo color) blocks are equal."
(check-expect (block=? (make-block 0 0 'black)
                       (make-block 0 0 'red))
              true)

"Blocks with different coordinates are different."
(check-expect (block=? (make-block 0 1 'black)
                       (make-block 0 0 'black))
              false)
(check-expect (block=? (make-block 0 0 'black)
                       (make-block 0 1 'black))
              false)

"Block move."
(check-expect (block=? (block-move 0 0 (make-block 0 0 'black))
                       (make-block 0 0 'black))
              true)
(check-expect (block=? (block-move 0 1 (make-block 0 0 'black))
                       (make-block 0 1 'black))
              true)

"Block set membership."
(check-expect (blocks-contains? empty (make-block 0 0 'black))
              false)
(check-expect (blocks-contains? (list (make-block 0 0 'black))
                                (make-block 0 0 'black))
              true)
(check-expect (blocks-contains? (list (make-block 0 1 'black))
                                (make-block 0 0 'black))
              false)

"Block set containment."
(check-expect (blocks-subset? empty empty)
              true)
(check-expect (blocks-subset? empty (list (make-block 0 0 'black)))
              true)
(check-expect (blocks-subset? (list (make-block 0 0 'black))
                              (list (make-block 0 0 'black)))
              true)

"Block set equality."
(check-expect (blocks=? (list (make-block 0 0 'black))
                        (list (make-block 0 0 'black)))
              true)
(check-expect (blocks=? (list (make-block 0 0 'black))
                        (list (make-block 0 1 'black)))
              false)

"Block set intersection."
(check-expect (blocks=? (blocks-intersect empty empty) 
                        empty)
              true)
(check-expect (blocks=? (blocks-intersect empty (list (make-block 0 0 'black)))
                        empty)
              true)
(check-expect (blocks=? (blocks-intersect (list (make-block 0 0 'black)) empty) 
                        empty)
              true)
(check-expect (blocks=? (blocks-intersect (list (make-block 0 0 'black))
                                          (list (make-block 0 0 'black)))
                        (list (make-block 0 0 'black)))
              true)

"Block set union."
(check-expect (blocks=? (blocks-union empty empty) empty)
              true)
(check-expect (blocks=? (blocks-union empty (list (make-block 0 0 'black)))
                        (list (make-block 0 0 'black)))
              true)
(check-expect (blocks=? (blocks-union (list (make-block 0 0 'black)) empty) 
                        (list (make-block 0 0 'black)))
              true)
(check-expect (blocks=? (blocks-union (list (make-block 0 0 'black))
                                      (list (make-block 0 0 'black)))
                        (list (make-block 0 0 'black)))
              true)
(check-expect (blocks=? (blocks-union (list (make-block 0 0 'black))
                                      (list (make-block 0 1 'black)))
                        (list (make-block 0 0 'black)
                              (make-block 0 1 'black)))
              true)

"Block set cardinality."
(check-expect (blocks-count empty) 0)
(check-expect (blocks-count (list (make-block 0 0 'black))) 1)
(check-expect (blocks-count (blocks-union (list (make-block 0 0 'black))
                                          (list (make-block 0 0 'black))))
              1)
(check-expect (blocks-count (blocks-union (list (make-block 0 0 'black))
                                          (list (make-block 1 1 'black))))
              2)

"Block set maximal y-coordinate."
(check-expect (blocks-max-y empty) 0)
(check-expect (blocks-max-y (list (make-block 0 1 'black))) 1)
(check-expect (blocks-max-y (list (make-block 1 0 'black))) 0)

"Block set minimal x-coordinate."
(check-expect (blocks-min-x empty) board-width)
(check-expect (blocks-min-x (list (make-block 0 1 'black))) 0)
(check-expect (blocks-min-x (list (make-block 1 0 'black))) 1)

"Block set maximal x-coordinate."
(check-expect (blocks-max-x empty) 0)
(check-expect (blocks-max-x (list (make-block 0 1 'black))) 0)
(check-expect (blocks-max-x (list (make-block 1 0 'black))) 1)

"Block set move."
(check-expect (blocks=? (blocks-move 0 0 empty) empty)
              true)
(check-expect (blocks=? (blocks-move 0 0 (list (make-block 0 0 'black)))
                        (list (make-block 0 0 'black)))
              true)
(check-expect (blocks=? (blocks-move 1 1 (list (make-block 0 0 'black)))
                        (list (make-block 1 1 'black)))
              true)

"Block overflow."
(check-expect (blocks-overflow? empty) 
              false)
(check-expect (blocks-overflow? (list (make-block 0 0 'black))) 
              true)
(check-expect (blocks-overflow? (list (make-block 0 1 'black))) 
              false)

"Block set row selection."
(check-expect (blocks=? (blocks-row empty 0) empty) 
              true)
(check-expect (blocks=? (blocks-row (list (make-block 0 0 'black)) 1) empty) 
              true)
(check-expect (blocks=? (blocks-row (list (make-block 0 0 'black)) 0)
                        (list (make-block 0 0 'black)))
              true)

"Full row."
(check-expect (full-row? empty 0) false)

(generate-report)