(module unit-test mzscheme
        (require "sutil.scm")
        (provide unit-tests)
        
        (define (pad-left S n)
          (let ((l (string-length S)))
            (if (>= l n)
                (substr S l)
                (string-append
                 (substr (make-string n #\space) 0 (- n l))
                 S))))
        
        (define (pad-right S n)
          (let ((l (string-length S)))
            (if (>= l n)
                (substr S l)
                (string-append 
                 S
                 (substr (make-string n #\space) 0 (- n l))))))

        (define (test number description tester)
          (let ((N (pad-left (format "~a" number) 3))
                (D (pad-right description 40)))
            (display (format "~a - ~a:" N D))
            (flush-output)
            (let ((R (with-handlers ((exn:fail? (lambda (exn)
                                                  (lambda ()
                                                    (format "exception: ~a" (exn-message exn))))))
                       (tester))))
              (display (format "~a~%" (if (eq? R #t) "OK"
                                          (if (eq? R #f) "NOK"
                                              (if (procedure? R) (R) R)))))
              (flush-output)
              number)))

        (define N        0)
        (define in-tests 0)
        
        (define (tests L)
          (if (= in-tests 0) (set! N 0))
          (letrec ((f (lambda (L)
                        (if (null? L)
                            #t
                            (begin
                              (set! N (+ N 1))
                              (test N (caar L) (cadar L))
                              (f (cdr L)))))))
            (set! in-tests (+ in-tests 1))
            (f L)
            (set! in-tests (- in-tests 1)))
          #t)
          

        (define-syntax utest
          (syntax-rules ()
            ((_ (description tester))
             (list description tester))))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define-syntax unit-tests
          (syntax-rules ()
            ((_ t1 ...)
             (tests
              (list
               (utest t1)
               ...)))))
        
        )


;;#+pod
;
;=pod
;
;=syn scm,8
;
;=wikiwikiwiki
;
;=unit-test - Simple unit testing
;
;This module exports syntax to do unit testing.
;
;=Synopsis
;
; >(require (planet "unit-test.scm" ("oesterholt" "ho-utils.plt" 1 0)))
; >(define CONNSTR (if (eq? (getenv "CONNSTR") #f)
;                     #f
;                     (getenv "CONNSTR")))
; >
; >(unit-tests
;   ("connstr"          (lambda () (if (eq? CONNSTR #f)
;                                      "Environment variable CONNSTR must be set to a valid PostgreSQL connection string"
;                                      #t)))
;   ("basic connection" (lambda () (let ((sqld (sqld-psql-new CONNSTR)))
;                                    (let ((sqli (sqli-connect sqld)))
;                                      (if (or (eq? sqli #f) (sqli-error? sqli))
;                                          (sqli-error-message sqli)
;                                         #t)))))
;   )
;  1 - connstr                                 :Environment variable CONNSTR must be set to a valid PostgreSQL connection string
;  2 - basic connection                        :exception: Function 'PQconnectdb' has not been loaded
;                                                                                             
; >
;
;
;=Info
;
;(c) 2007 Hans !Oesterholt-Dijkema. Distributed under LGPL. \\
;Contact: send email to hans in domain elemental-programming.org. \\
;Homepage: [http://www.elemental-programming.org].
;
;=wikiwikiwiki
;
;=cut
;=verbatim
;
;##