;;; File:
;;;   unit-test.ss
;;; Authors:
;;;   Janet L. N. Davis
;;;   Samuel A. Rebelsky
;;; Version:
;;;;  0.4 of 22 September 2006
;;; Summary:
;;;   A set of procedures that support a simple form of unit testing
;;;   for Scheme code.
;;; Contents:
;;;   [Forthcoming]
;;; Use:
;;;   In general, you begin a series of tests by calling (begin-tests!).
;;;   You conduct each test with the "test" procedure, which takes two
;;;     parameters: (1) a list that represents an expression to be evaluated
;;;     (2) the expected value of that expression.
;;;   When you are done, you end the series of tests by calling (end-tests!).
;;;   This procedure will report on all the failures.
;;; Practica:
;;;   (begin-tests!)
;;;   (test! '(reverse (list 'a 'b 'c)) (list 'c 'b 'a))
;;;   (end-tests!)
;;; History:
;;;   At end.

; +-----------+------------------------------------------------------------
; | Variables |
; +-----------+

;;; Named Value:
;;;   tests
;;; Type:
;;;   integer
;;; Summary:
;;;   A count of the tests conducted.
(define tests 0)

;;; Named Value:
;;;   failures
;;; Type:
;;;   List of lists.
;;; Summary:
;;;   A list of the failures encountered, in reverse order.  An error
;;;   is represented with the following form
;;;     (EXPRESSION EXPECTED-VALUE ACTUAL-VALUE)
(define failures null)

;;; Named Value:
;;;   errors
;;; Type:
;;;   List of lists.
;;; Summary:
;;;   A list of the errors encountered, in reverse order.  An error
;;;   is represented with the following form
;;;     (EXPRESSION EXCEPTION)
(define errors null)

; +--------------------+---------------------------------------------------
; | Primary Procedures |
; +--------------------+

;;; Procedure:
;;;   begin-tests!
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Prepare the system for testing.
;;; Produces:
;;;   Nothing.
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   The system is now in a state that permits use of the testing procedures.
(define begin-tests!
  (lambda ()
    (set! failures null)
    (set! tests 0)))

;;; Procedure:
;;;   test!
;;; Parameters:
;;;   exp, a Scheme value that represents an expression to be evaluated.
;;;   expected, a Scheme value that represents the expected result
;;; Purpose:
;;;   Evaluate exp and determine whether or not it equals expected.  In
;;;   either case, updates our testing statistics.
;;; Produces:
;;;   (nothing)
;;; Preconditions:
;;;   The test system has been initialized with begin-tests!
;;;   The test system has not been finished with end-tests!
;;; Postconditions:
;;;   The information in the test system has been updated appropriately.
(define test!
  (lambda (exp expected) 
    (set! tests (+ tests 1))
    (with-handlers
        ((exn:fail?
          (lambda (exception)
            (set! errors
                  (cons (list exp exception) errors)))))
        (let ((result (eval exp)))
          (if (not (equal? result expected))
              (set! failures (cons (list exp expected result) failures)))))))
;;; Procedure:
;;;   test-error!
;;; Parameters:
;;;   exp, a Scheme value that represents an expression to be evaluated.
;;;   The expression should be one that is expected to generate an error.
;;; Purpose:
;;;   Evaluate exp and determine whether it generates an error.
;;;   If there is an error, the test succeeds.
;;;   Otherwise, the test fails.
;;;   In either case, updates our testing statistics.
;;; Produces:
;;;   (nothing)
;;; Preconditions:
;;;   The test system has been initialized with begin-tests!
;;;   The test system has not been finished with end-tests!
;;; Postconditions:
;;;   The information in the test system has been updated appropriately.
(define test-error!
  (lambda (exp) 
    (set! tests (+ tests 1))
    (with-handlers
        ((exn:fail?
          (lambda (exception)
            ; This is what we expected!
            #t )))
        (let ((result (eval exp)))
          ((set! failures (cons (list exp "an error" result) failures)))))))

;;; Procedure:
;;;   end-tests!
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Completes a sequence of tests.
;;; Produces:
;;;   (nothing) [displays results]
;;; Preconditions:
;;;   The test system has been initialized with begin-tests!
;;;   The test system has not been finished with end-tests!
;;; Postconditions:
;;;   Information about the tests has been displayed.
(define end-tests!
  (lambda ()
    (let* ((num-errors (length errors))
           (num-failures (length failures))
           (total-failures (+ num-errors num-failures)))
      (display tests)
      (display " tests conducted.")
      (newline)
      (cond ((= total-failures 0) (display "No tests failed."))
            ((= total-failures 1) (display "One test failed."))
            (else (display num-failures) (display " tests failed")))
      (newline)
      (cond ((= num-errors 0) 
             (if (> total-failures 0) (display "No errors encountered.")))
            ((= num-errors 1) (display "One error encountered."))
            (else (display num-errors) (display " errors encountered")))
      (newline)
      (report-errors)
      (cond ((= num-failures 0) 
             (if (> total-failures 0) (display "No non-erroneous tests failed.")))
            ((= num-failures 1) (display "One non-erroneous test failed."))
            (else (display num-failures) (display " non-erroneous tests failed")))
      (newline)
      (report-failures)
      (if (= 0 (+ num-failures num-errors))
          (display "CONGRATULATIONS!  All tests passed.")
          (display "Sorry.  You'll need to fix your code."))
      (newline))))

; +-----------------+------------------------------------------------------
; | Local Utilities |
; +-----------------+

(define report-failures
  (lambda ()
    (report-failures-helper (reverse failures))))

(define report-failures-helper
  (lambda (remaining-failures)
    (if (not (null? remaining-failures))
        (let ((error (car remaining-failures)))
          (display "  For ")
          (write (car error))
          (display " expected [")
          (write (cadr error))
          (display "] got [")
          (write (caddr error))
          (display "]")
          (newline)
          (report-failures-helper (cdr remaining-failures))))))

(define report-errors
  (lambda ()
    (report-errors-helper (reverse errors))))

(define report-errors-helper
  (lambda (remaining-errors)
    (if (not (null? remaining-errors))
        (let ((exception (car remaining-errors)))
          (display "  The expression ")
          (display (car exception))
          (display " failed to evaluate because [")
          (display (exn-message  (cadr exception)))
          (display "]")
          (newline)
          (report-errors-helper (cdr remaining-errors))))))

; +---------+--------------------------------------------------------------
; | History |
; +---------+

; Friday, 22 September 2006 (v 0.1) [Janet L. N. Davis and Samuel A. Rebelsky]
; * Created.  Did not yet handle errors.

; Friday, 22 September 2006 (v 0.2) [Janet L. N. Davis and Samuel A. Rebelsky]
; * Added error handling code.
; * Added documentation.
; * Moved tests of the testing code to a separate file.
; * Renamed three core procedures.

; Friday, 22 September 2006 (v 0.3) [Janet L. N. Davis]
; * Added test-error! procedure.
; * Modified test! to use the exn:fail? procedure to test for an exception.
;   (This procedure is recommended as it does not catch the break exception.)
; * Fixed bug that caused report-failures-helper and report-errors-helper
;   to infinite-loop if there were multiple failures or errors.

; Friday, 22 September 2006 (v 0.4) [Samuel A. Rebelsky]
; * Replaced calls to "display" with calls to "write" for the expressions.
;   (Otherwise, the output is not quite so clear.)
; * Updated the final report for clarity (now reports total failures, errors,
;   and non-error failures).

; +-------+----------------------------------------------------------------
; | To Do |
; +-------+

; * Document helper procedures.