#cs
(module minijava-test mzscheme
  (require (lib "reduction-semantics.ss" "reduction-semantics")
           (lib "helper.ss" "reduction-semantics")
           (lib "generator.ss" "reduction-semantics")
           (lib "list.ss")
           "minijava.ss"
           "minijava-run.ss"
           "minijava-check.ss")

  (define (test a b)
    (if (equal? a b)
        (printf "~s = ~s~n" a b)
        (error 'test "~s != ~s" a b)))

  ;; ------------------------------

  (define (run-fish M)
    (caar (last-pair
           (function-reduce* (:->mj fish-P) M result? 10))))
  
  ;; Tests:
  (test 7 
        (run-fish '(((new colorfish) |.| getWeight ()) ())))
  (test 7 
        (run-fish '((((fish) (new colorfish)) |.| getWeight ()) ())))
  (test 9
        (run-fish '(((new colorfish) : colorfish |.| color := 9) ())))
  (test 'null
        (run-fish '(((pickyfish)null) ())))
  (test 'Error:bad-cast 
        (run-fish '((((pickyfish) (new colorfish)) |.| getWeight ()) ())))
  (test 'Error:null
        (run-fish '((null |.| getWeight ()) ())))
  (test 'Error:null
        (run-fish '((null : fish |.| size) ())))
  (test 'Error:null
        (run-fish '((null : fish |.| size := 12) ())))

  ;; ------------------------------

  ;; Avoid silly tests:
  (define (:-P P)
    (unless (P? P)
      (error ':-P "not a P: ~e" P))
    (:-p P))
  
  (define (check-in-fish M)
    ;; Replace the body expression in fish-P with M:
    (let ([P (let loop ([P fish-P])
               (if (null? (cdr P))
                   (list M)
                   (cons (car P) (loop (cdr P)))))])
      (:-P P)))
  
  (test 'num (:-P fish-P))
  (test 'num (check-in-fish '(+ 1 2)))
  (test 'num (check-in-fish '(add1 1)))
  (test 'Object (check-in-fish '(new Object)))
  (test 'fish (check-in-fish '(new fish)))
  (test 'colorfish (check-in-fish '(new colorfish)))
  (test 'fish (check-in-fish '((fish) (new colorfish))))
  (test 'num (check-in-fish '((new colorfish) : colorfish |.| color)))
  (test 'num (check-in-fish '((new colorfish) : fish |.| size)))
  (test 'num (check-in-fish '((new fish) : fish |.| size)))
  (test 'num (check-in-fish '((new colorfish) : colorfish |.| color := 7)))
  (test 'num (check-in-fish '((new colorfish) : fish |.| size := 7)))
  (test 'num (check-in-fish '((new fish) : fish |.| size := 7)))

  (test 'num (check-in-fish '(null |.| getWeight ())))
  (test 'num (check-in-fish '(null : colorfish |.| color)))
  (test 'num (check-in-fish '(null : colorfish |.| color := 7)))

  (test #f (check-in-fish 'free-var))
  (test #f (check-in-fish '(+ 7 (new fish))))
  (test #f (check-in-fish '(+ 7 null)))
  (test #f (check-in-fish '(add1 null)))
  (test #f (check-in-fish '((fish) 7))) ; 7 is not a class type
  (test #f (check-in-fish '((new fish) : fish |.| color := 7)))
  (test #f (check-in-fish '(null : fish |.| color := 7)))
  (test #f (check-in-fish '((new fish) : colorfish |.| color := 7)))
  (test #f (check-in-fish '(super this : fish |.| getWeight ())))
  
  (test 'num (:-P '(7)))
  (test 'num (:-P '((class fish extends Object () ()) 7)))
  (test #f (:-P '((class fish extends fish () ()) 7)))
  (test #f (:-P '((class Object extends fish () ()) 7)))
  (test 'num (:-P '((class fish extends Object ((num size = 8)) ()) 7)))
  (test #f (:-P '((class fish extends Object ((num size = null)) ()) 7)))
  (test #f (:-P '((class fish extends Object ((fish size = 7)) ()) 7)))
  (test 'num (:-P '((class fish extends Object ((fish size = null)) ()) 7)))
  (test #f (:-P '((class fish extends Object ((colorfish size = null)) ()) 7)))
  
  (test 'fish (:-P '((class fish extends Object () ((fish getWeight() null)))
                     ((new fish) |.| getWeight ()))))
  (test 'Object (:-P '((class fish extends Object () ((Object getWeight((Object a)) a)))
                       ((new fish) |.| getWeight (null)))))
  (test 'Object (:-P '((class fish extends Object () ((Object getWeight((fish a)) a)))
                       ((new fish) |.| getWeight (null)))))
  (test #f (:-P '((class fish extends Object () ((fish getWeight((Object a)) a)))
                  ((new fish) |.| getWeight (null)))))
  
  ;; ------------------------------

  'done)