(module test-util mzscheme
  (provide test test-syn-err tests reset-count
           syn-err-test-namespace
           print-tests-passed)
  
  (define syn-err-test-namespace (make-namespace))
  (parameterize ([current-namespace syn-err-test-namespace])
    (eval '(require "../reduction-semantics.ss")))
  
  (define-syntax (test stx)
    (syntax-case stx ()
      [(_ expected got)
       (with-syntax ([line (syntax-line (syntax got))]
                     [fn (if (path? (syntax-source (syntax got)))
                             (path->string (syntax-source (syntax got)))
                             "<unknown file>")])
         (syntax/loc stx (test/proc (λ () expected) got line fn)))]))
  
  (define-syntax (test-syn-err stx)
    (syntax-case stx ()
      [(_ exp regexp)
       (syntax/loc stx
        (test
         (parameterize ([current-namespace syn-err-test-namespace])
           (with-handlers ((exn:fail:syntax? exn-message))
             (expand 'exp)
             'no-error-raised))
         regexp))]))
  
  (define tests 0)
  (define failures 0)
  (define (reset-count) (set! tests 0))
  
  (define (print-tests-passed filename)
    (cond
      [(= 0 failures)
       (printf "~a: all ~a tests passed.\n" filename tests)]
      [else
       (printf "~a: ~a test~a failed.\n" filename failures (if (= 1 failures) "" "s"))]))
  
  (define (test/proc run expected line filename)
    ;(printf "testing line ~s:~s\n" filename line)
    (let ([got (run)])
      (set! tests (+ tests 1))
      (unless (matches? got expected)
        (set! failures (+ 1 failures))
        (fprintf (current-error-port)
                 "test/proc: file ~a line ~a:\n     got ~s\nexpected ~s\n\n" 
                 filename 
                 line
                 got
                 expected))))
  
  (define (matches? got expected)
    (cond
      [(regexp? expected)
       (and (string? got) (regexp-match expected got) #t)]
      [else
       (equal? got expected)])))