;;; The beginning of a test module for mp3.

(module mp3-test (lib "eopl.ss" "eopl")
  (require "drscheme-init.scm")
  (require "mp3-data-structures.scm")
  (require (only "mp3.scm"
                 empty-env apply-env extend-env   ; EoPL exercise 2.5
                 has-binding?                     ; EoPL exercise 2.9
                 extend-env*                      ; EoPL exercise 2.10
                 parse-prefix-list                ; task 2
                 calculate                        ; task 3
                 value-of                         ; task 4
                 ))

  (stop-after-first-error #f) ; (use #t to stop testing after failure)

  ;; test : Symbol * (A B ... -> Z) * (list A B ...) * Z -> void or error
  ;; usage: (test nm fcn args ans) applies fcn to args; if the 
  ;;        result is not equal to ans, then signals a test failure.

  (define test
    (lambda (name proc args result)
      (test-aftermath name
                      args
                      result
                      (run-experiment proc args result equal?))))
  
  ;; test/comparison :
  ;;     Symbol * (A B ... -> Z) * (list A B ...) * Z * (Z -> boolean)
  ;;     -> void
  ;; usage: (test/comparison nm fcn args res okay?)
  ;; applies fcn to args and uses okay? to compare the result against res;
  ;; if the okay? predicate returns false, then a test failure is signalled.

  (define test/comparison
    (lambda (name proc args result correct?)
      (test-aftermath name
                      args
                      result
                      (run-experiment proc args result correct?))))
  
  ;; test-aftermath : Symbol * (list A B ...) * (cons Boolean Z) -> void
  ;;                  -> void
  ;; usage: (test-aftermath name args t) reports the test outcome t.

  (define test-aftermath
    (lambda (name args result t)
      (let ((was-a-success (car t))
            (answer-given (cdr t)))
        (cond
         (was-a-success (eopl:printf "Success on test ~a~%" (cons name args)))
         (else
          (cond ((stop-after-first-error) 
                 (eopl:error name
                             "~a evaluated to ~a, but we want: ~a" 
                             (cons name args) answer-given result))
                (else
                 (eopl:printf 
                  "Failure on test ~a; evaluated to ~a, but we want: ~a~%"
                  (cons name args)
                  answer-given result)
                 )))))))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; EOPL 2.5

  ;; glass-box tests (which are *not* representation-independent)

  (test 'empty-env empty-env
        (list)
        '())

  (test 'extend-env extend-env
        (list 'x 47 (empty-env))
        '((x . 47)))

  ;; black-box tests (which are representation-independent)

  (let ((env1
         (extend-env 'd 6
          (extend-env 'y 8
           (extend-env 'x 7
            (extend-env 'y 14
             (empty-env)))))))
    (test 'apply-env apply-env
          (list env1 'y)
          8))
  
  ;; EOPL 2.9
  
  ;; EOPL 2.11
  
  (let ((env1 (extend-env* '(d y x) '(6 8 7) (empty-env))))
    (test 'apply-env apply-env
          (list env1 'y)
          8))
  
  ;; task 2

  (test 'calculate calculate
        (list (scan&parse "3 + 4 * 5 - 6"))
        17)

  (test 'calculate calculate
        (list (subtraction-exp
                (addition-exp
                  (constant-exp 3)
                  (multiplication-exp
                    (constant-exp 4)
                    (constant-exp 5)))
                (constant-exp 6)))
        17)

  ;; task 3

  (test 'value-of value-of
        (list (scan&parse "x * y + z")
              (extend-env* '(x y z) '(4 5 6) (empty-env)))
        26)

  (test 'value-of value-of
        (list (addition-exp
                (multiplication-exp
                  (var-exp 'x)
                  (var-exp 'y))
                (var-exp 'z))
              (extend-env* '(x y z) '(4 5 6) (empty-env)))
        26)

  ;; EOPL 1.31 (task 4)

  (test 'parse-prefix-list parse-prefix-list
        (list '(- - 3 2 - 4 - 12 7))
        (diff-exp
          (diff-exp
            (const-exp 3)
            (const-exp 2))
          (diff-exp
            (const-exp 4)
            (diff-exp
              (const-exp 12)
              (const-exp 7)))))

  )