(module tests mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1)))
  (require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 1)))
  (require (lib "etc.ss"))
  (require "../../memoize.ss")

  (define number-of-runs (make-parameter 0))
  (define (increment!)
    (number-of-runs (add1 (number-of-runs))))

  (define-struct memoize-result (results run-count) #f)

  (define-syntax run/memo
    (syntax-rules (memo-lambda define/memo)
      [(_ (memo-lambda formals body0 body1 ...) actual ...)
       (parameterize ([number-of-runs 0])
         (let* ([p (memo-lambda formals
                     (increment!)
                     body0 body1 ...)]
                [results (build-list 50 (lambda (i) (p actual ...)))])
           (make-memoize-result results (number-of-runs))))]
      [(_ (define/memo (name . formals) body0 body1 ...) actual ...)
       (parameterize ([number-of-runs 0])
         (define/memo (p . formals)
           (increment!)
           body0 body1 ...)
         (let ([results (build-list 50 (lambda (i) (p actual ...)))])
           (make-memoize-result results (number-of-runs))))]))

  (define-simple-assertion (assert-memo actual expected)
    (and (memoize-result? actual)
         (andmap (lambda (elt) (eq? elt expected)) (memoize-result-results actual))
         (= (memoize-result-run-count actual) 1)))

  (define memo-lambda-tests
    (make-test-suite
     "memo-lambda tests"
     (make-test-case "memo-lambda with zero arguments"
                     (assert-memo (run/memo (memo-lambda () 3))
                                  3))
     (make-test-case "memo-lambda with one argument"
                     (assert-memo (run/memo (memo-lambda (a) (add1 a)) 2)
                                  3))
     (make-test-case "memo-lambda with four arguments"
                     (assert-memo (run/memo (memo-lambda (a b c d) (+ a b c d)) 1 3 7 15)
                                  26))
     (make-test-case "memo-lambda with 2 fixed args and variable arity"
                     (assert-memo (run/memo (memo-lambda (a b . rest) (apply + (cons a (cons b rest)))) 1 3 7 15)
                                  26))
     (make-test-case "memo-lambda with totally variable arity"
                     (assert-memo (run/memo (memo-lambda args (apply + args)) 1 3 7 15)
                                  26))
     ))

  (define define/memo-tests
    (make-test-suite
     "define/memo tests"
     (make-test-case "define/memo with zero arguments"
                     (assert-memo (run/memo (define/memo (p) 3))
                                  3))
     (make-test-case "define/memo with one argument"
                     (assert-memo (run/memo (define/memo (p a) (add1 a)) 2)
                                  3))
     (make-test-case "define/memo with four arguments"
                     (assert-memo (run/memo (define/memo (p a b c d) (+ a b c d)) 1 3 7 15)
                                  26))
     (make-test-case "define/memo with 2 fixed args and variable arity"
                     (assert-memo (run/memo (define/memo (p a b . rest) (apply + (cons a (cons b rest)))) 1 3 7 15)
                                  26))
     (make-test-case "memo-lambda with totally variable arity"
                     (assert-memo (run/memo (define/memo (p . args) (apply + args)) 1 3 7 15)
                                  26))
     ))

  (define all-tests
    (make-test-suite
     "all memoize.plt tests"
     memo-lambda-tests
     define/memo-tests
     ))

  (test/graphical-ui all-tests)

  (provide all-tests))