(module test-util mzscheme
  (provide test test-syn-err tests reset-count
           syn-err-test-namespace)
  
  (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 (test/proc (λ () expected) got line fn)))]))
  
  (define-syntax (test-syn-err stx)
    (syntax-case stx ()
      [(_ exp regexp)
       (syntax
        (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 (reset-count) (set! tests 0))
  
  (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)
        (error 'test/proc "file ~a line ~a: got ~s expected ~s" 
               filename 
               line
               got
               expected))))
  
  (define (matches? got expected)
    (cond
      [(regexp? expected)
       (and (string? got) (regexp-match expected got) #t)]
      [else
       (equal? got expected)])))