;; @(#)$Id: test-homework.scm,v 1.13 2005/02/18 22:12:50 leavens Exp $

(module test-homework mzscheme
  (provide test-hw1 test-hw2 test-hw3 test-hw4 test-hw5
           test-hw6 test-hw7 test-hw8 test-hw9 test-hw10
           test-hw11 test-hw12 test-hw13 test-hw14 test-hw15
           test-ex show-test-output! hide-test-output!
	   run-test-case-maker run-test-case regression-test-maker
           run-regression-test run-regression-tests-maker
           run-regression-tests-equal?
	   displayln writeln)

  (require (lib "displayln.scm" "lib342")
	   (lib "writeln.scm" "lib342")
	   (lib "localize.scm" "lib342")
           (lib "pretty.ss" "mzlib"))
  
  (define *show-test-output* #f)

  (define show-test-output!
    (lambda ()
      (set! *show-test-output* #t)))

  (define hide-test-output!
    (lambda ()
      (set! *show-test-output* #f)))

  (define cs342:test-maker
    ;; Assumes *cs342:hwdir* from localize.scm.
    (let ((testdir *cs342:hwdir*))
      (lambda (hw-number)
        (lambda (procedure-name)
          (if (not (string? procedure-name))
              (error "argument must be a string, like \"subst\""))
          (let ((file-to-load (string-append testdir
                                             "hw"
                                             hw-number
                                             "/"
                                             procedure-name
                                             ".tst")))
	    (load file-to-load))))))
  
  (define test-hw1
    (lambda (procedure-name)
      ((cs342:test-maker "1")
       procedure-name)))
  (define test-hw2
    (lambda (procedure-name)
      ((cs342:test-maker "2")
       procedure-name)))
  (define test-hw3
    (lambda (procedure-name)
      ((cs342:test-maker "3")
       procedure-name)))
  (define test-hw4
    (lambda (procedure-name)
      ((cs342:test-maker "4")
       procedure-name)))
  (define test-hw5
    (lambda (procedure-name)
      ((cs342:test-maker "5")
       procedure-name)))
  (define test-hw6
    (lambda (procedure-name)
      ((cs342:test-maker "6")
       procedure-name)))
  (define test-hw7
    (lambda (procedure-name)
      ((cs342:test-maker "7")
       procedure-name)))
  (define test-hw8
    (lambda (procedure-name)
      ((cs342:test-maker "8")
       procedure-name)))
  (define test-hw9
    (lambda (procedure-name)
      ((cs342:test-maker "9")
       procedure-name)))
  (define test-hw10
    (lambda (procedure-name)
      ((cs342:test-maker "10")
       procedure-name)))
  (define test-hw11
    (lambda (procedure-name)
      ((cs342:test-maker "11")
       procedure-name)))
  (define test-hw12
    (lambda (procedure-name)
      ((cs342:test-maker "12")
       procedure-name)))
  (define test-hw13
    (lambda (procedure-name)
      ((cs342:test-maker "13")
       procedure-name)))
  (define test-hw14
    (lambda (procedure-name)
      ((cs342:test-maker "14")
       procedure-name)))
  (define test-hw15
    (lambda (procedure-name)
      ((cs342:test-maker "15")
       procedure-name)))

  (define test-ex
    (lambda (procedure-name)
      ((cs342:test-maker "ex")
       procedure-name)))
  
  (define cs342:print-test-case-prefix writeln)
  
  (define run-test-case-maker
    (lambda (print-code eval-print-result)
      ;; REQUIRES: eval-print-result prints a separator and the result,
      ;;           with a newline at the end of it all.
      ;; EFFECT: prints the code and the result of executing the code.
      (lambda (code)
        (print-code code)
        (eval-print-result code))))
  
  (define cs342:evals-to-symbol '==>)
  (define cs342:equals-symbol '=)
  
  (define cs342:before-connective-spaces "        ")
  
  (define cs342:print-connective-maker
    (lambda (connective)
      (lambda ()
        (display cs342:before-connective-spaces)
        (display connective)
        (display " "))))
  
  (define cs342:eval-print-maker
    (lambda (writeln)
      (lambda (code)
	((cs342:print-connective-maker cs342:evals-to-symbol))
	(writeln (eval code)))))
  
  (define run-test-case
    (lambda (code)
      ((run-test-case-maker
	pretty-print
	(cs342:eval-print-maker pretty-print))
       code)))
  
  (define cs342:num-wrong
    0)
  
  (define cs342:regression-test-maker-maker
    (lambda (print-connective-maker)
      (let ((print-arrow (print-connective-maker cs342:evals-to-symbol))
            (print-equal-sign (print-connective-maker cs342:equals-symbol)))
        (lambda (okay? print-code print-result)
          ;; REQUIRES: connective is either cs342:evals-to-symbol
          ;;                         or cs342:equals-symbol
          (lambda (code connective expected)
	    (if *show-test-output*
		(print-code code))
            (let ((result (eval code)))
              (cond
	       ((eq? connective cs342:evals-to-symbol)
		(if (okay? result expected)
		    (if *show-test-output*
			(begin
			  (print-arrow)
			  (print-result result)))
		    (begin
		      (if (not *show-test-output*)
			    (print-code code))
		      (set! cs342:num-wrong (+ cs342:num-wrong 1))
		      (print-arrow)
		      (print-result result)
		      (display "  EXPECTED: ")
		      (print-result expected))))
	       ((eq? connective cs342:equals-symbol)
		(let ((expected-result (eval expected)))
		  (if (okay? result expected-result)
		      (if *show-test-output*
			  (begin
			    (print-equal-sign)
			    (print-code expected)))
		      (begin
			(if (not *show-test-output*)
			    (print-code code))
			(set! cs342:num-wrong (+ cs342:num-wrong 1))
			(print-arrow)
			(print-result result)
			(display "  EXPECTED: ")
			(print-result expected-result)
			(display "        <== ")
			(print-code expected)))))
	       (else (error "Bad connective in test case : " connective)))
              ))))))
  
  (define regression-test-maker
    (lambda (okay? print-code print-result)
      ((cs342:regression-test-maker-maker cs342:print-connective-maker)
       okay? print-code print-result)))
  
  (define run-regression-test
    (lambda (code connective expected)
      ((regression-test-maker equal? pretty-print pretty-print)
       code connective expected)))
  
  (define run-regression-tests-maker
    (lambda (okay? print-code print-result)
      (let ((regress (regression-test-maker okay? print-code print-result)))
        (lambda (test-table)
          (let ((old-num-wrong cs342:num-wrong))
            (for-each
             (lambda (test) (regress (car test) (cadr test) (caddr test)))
             test-table)
            (if (not (= old-num-wrong cs342:num-wrong))
                (displayln "TOTAL UNEXPECTED RESULTS THIS TEST RUN: "
                           (- cs342:num-wrong old-num-wrong))
                (displayln "All tests passed!")))))))
  
  (define run-regression-tests-equal?
    (lambda (test-table)
      ((run-regression-tests-maker equal? pretty-print pretty-print)
       test-table)))
  )