;; To run the tests:
;;
;;   (require (planet "tests/record-case-tests.ss" ("dvanhorn" "tetris.plt" 1 0))
;;            (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8)))
;;   (test/text-ui tetris-tests)

#lang scheme
(provide tetris-tests)
(require (file "../tetris.ss"))
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8)))

(define tetris-tests
  (test-suite
   "Tests for tetris"
   
   (test-case 
    "Identical blocks are equal."
    (check-true 
     (block=? (make-block 0 0 'black)
              (make-block 0 0 'black))))
   
   (test-case 
    "Identical (modulo color) blocks are equal."
    (check-true
     (block=? (make-block 0 0 'black)    ;; An equal opportunity
              (make-block 0 0 'red))))   ;; block equality.
   
   (test-case
    "Blocks with different coordinates are different."
    (check-false
     (block=? (make-block 0 1 'black)
              (make-block 0 0 'black)))
    (check-false
     (block=? (make-block 0 0 'black)
              (make-block 0 1 'black))))
   
   (test-case
    "Block move."
    (check block=? 
           (block-move 0 0 (make-block 0 0 'black))
           (make-block 0 0 'black))
    
    (check block=? 
           (block-move 0 1 (make-block 0 0 'black))
           (make-block 0 1 'black)))
   
   (test-case
    "Block set membership."
    (check-false
     (blocks-contains? empty (make-block 0 0 'black)))
    (check-true
     (blocks-contains? (list (make-block 0 0 'black))
                       (make-block 0 0 'black)))
    (check-false
     (blocks-contains? (list (make-block 0 1 'black))
                       (make-block 0 0 'black))))
   
   (test-case
    "Block set containment."
    (check-true (blocks-subset? empty empty))
    (check-true (blocks-subset? empty (list (make-block 0 0 'black))))
    (check-true
     (blocks-subset? (list (make-block 0 0 'black))
                     (list (make-block 0 0 'black)))))
   
   (test-case
    "Block set equality."
    (check-true
     (blocks=? (list (make-block 0 0 'black))
               (list (make-block 0 0 'black))))
    
    (check-false
     (blocks=? (list (make-block 0 0 'black))
               (list (make-block 0 1 'black)))))
   
   (test-case
    "Block set intersection."
    (check blocks=?
           (blocks-intersect empty empty) 
           empty)
    (check blocks=?
           (blocks-intersect empty (list (make-block 0 0 'black)))
           empty)
    (check blocks=? 
           (blocks-intersect (list (make-block 0 0 'black)) empty) 
           empty)
    (check blocks=?
           (blocks-intersect (list (make-block 0 0 'black))
                             (list (make-block 0 0 'black)))
           (list (make-block 0 0 'black))))
   
   (test-case
    "Block set union."
    (check blocks=? (blocks-union empty empty) empty)
    (check blocks=? 
           (blocks-union empty (list (make-block 0 0 'black))) 
           (list (make-block 0 0 'black)))
    (check blocks=? 
           (blocks-union (list (make-block 0 0 'black)) empty) 
           (list (make-block 0 0 'black)))
    (check blocks=? 
           (blocks-union (list (make-block 0 0 'black))
                         (list (make-block 0 0 'black)))
           (list (make-block 0 0 'black)))
    (check 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))))
   
   (test-case 
    "Block set cardinality."
    (check-equal? (blocks-count empty) 0)
    (check-equal? (blocks-count (list (make-block 0 0 'black))) 1)
    (check-equal? (blocks-count (blocks-union (list (make-block 0 0 'black))
                                              (list (make-block 0 0 'black))))
                  1)
    (check-equal? (blocks-count (blocks-union (list (make-block 0 0 'black))
                                              (list (make-block 1 1 'black))))
                  2))
   
   (test-case
    "Block set maximal y-coordinate."
    (check-equal? (blocks-max-y empty) 0)
    (check-equal? (blocks-max-y (list (make-block 0 1 'black))) 1)
    (check-equal? (blocks-max-y (list (make-block 1 0 'black))) 0))
   
   (test-case
    "Block set minimal x-coordinate."
    (check-equal? (blocks-min-x empty) board-width)
    (check-equal? (blocks-min-x (list (make-block 0 1 'black))) 0)
    (check-equal? (blocks-min-x (list (make-block 1 0 'black))) 1))
   
   (test-case
    "Block set maximal x-coordinate."
    (check-equal? (blocks-max-x empty) 0)
    (check-equal? (blocks-max-x (list (make-block 0 1 'black))) 0)
    (check-equal? (blocks-max-x (list (make-block 1 0 'black))) 1))
   
   (test-case
    "Block set move."
    (check blocks=? (blocks-move 0 0 empty) empty)
    (check blocks=? 
           (blocks-move 0 0 (list (make-block 0 0 'black)))
           (list (make-block 0 0 'black)))
    (check blocks=?
           (blocks-move 1 1 (list (make-block 0 0 'black)))
           (list (make-block 1 1 'black))))
   
   (test-case
    "Block overflow."
    (check-false (blocks-overflow? empty))
    (check-true  (blocks-overflow? (list (make-block 0 0 'black))))
    (check-false (blocks-overflow? (list (make-block 0 1 'black)))))
   
   (test-case
    "Block set row selection."
    (check blocks=? (blocks-row empty 0) empty)
    (check blocks=? (blocks-row (list (make-block 0 0 'black)) 1) empty)
    (check blocks=? 
           (blocks-row (list (make-block 0 0 'black)) 0)
           (list (make-block 0 0 'black)))
    
    (test-case
     "Full row."
     (check-false (full-row? empty 0)))
    
   )))


(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8)))


(test/text-ui tetris-tests)