private/tests/tests.ss
(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 (lib "class.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 define/memo/class)
      [(_ (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/memo/class (name . formals) body0 body1 ...) actual ...)
       (parameterize ([number-of-runs 0])
         (define c%
           (class object%
             (public name)
             (define/memo (name . formals)
               (increment!)
               body0 body1 ...)
             (super-new)))
         (let* ([object (new c%)]
                [results (build-list 50 (lambda (i) (send object name actual ...)))])
           (make-memoize-result results (number-of-runs))))]))

  (define-assertion (assert-memo actual expected)
    (with-assertion-info (['memoize-result "not a memoized result"])
      (unless (memoize-result? actual)
        (fail-assertion)))
    (with-assertion-info (['consistent-results "did not return consistent results"])
      (unless (andmap (lambda (elt) (eq? elt expected)) (memoize-result-results actual))
        (fail-assertion)))
    (with-assertion-info (['ran-once "did not run exactly once"])
      (unless (= (memoize-result-run-count actual) 1)
        (fail-assertion))))

;    (and (memoize-result? actual)
;         (with-assertion-info ([
;         (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 class-tests
    (make-test-suite
     "compatibility of define/memo and class.ss"
     (make-test-case "define/memo in a class with zero arguments"
                     (assert-memo (run/memo (define/memo/class (p) 3))
                                  3))
     (make-test-case "define/memo in a class with one argument"
                     (assert-memo (run/memo (define/memo/class (p a) (add1 a)) 2)
                                  3))
     (make-test-case "define/memo in a class with four arguments"
                     (assert-memo (run/memo (define/memo/class (p a b c d) (+ a b c d)) 1 3 7 15)
                                  26))
     (make-test-case "define/memo in a class with 2 fixed args and variable arity"
                     (assert-memo (run/memo (define/memo/class (p a b . rest) (apply + (cons a (cons b rest)))) 1 3 7 15)
                                  26))
     (make-test-case "memo-lambda in a class with totally variable arity"
                     (assert-memo (run/memo (define/memo/class (p . args) (apply + args)) 1 3 7 15)
                                  26))
     ))

  ;; TODO: eq-vs-equal-tests
  ;; (define string1 "dave")
  ;; (define string2 (string-append "da" "ve"))
  ;; (define/memo (f1 str)
  ;;   (printf "f1: ~a~n" str)
  ;;   (string-length str))
  ;; (define/memo* (f2 str)
  ;;   (printf "f2: ~a~n" str)
  ;;   (string-length str))

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

  (test/graphical-ui all-tests)

  (provide all-tests))