make-test-suite with setup/teardown actions

Khorev Sergey <[email protected]>
Newsgroups gmane.lisp.scheme.plt.schematics
Message-ID <F1BE47CAD645D311A8F7006097AD0C81032F79CD@HERMES>
I wanted it for several weeks and finally I made it :))
I'm not an experienced Scheme hacker, so my code isn't ideal (I think it can
be transformed to work in expansion time, not execution). Any feedback is
welcome.

(require (lib "test.ss" "schemeunit"))
(require (lib "assert.ss" "schemeunit"))
(require (lib "match.ss"))
(require (lib "text-ui.ss" "schemeunit"))

;;; using macro just to keep SchemeUnit setup/teardown form for test-case
(define-syntax make-test-suite+
  (syntax-rules ()
    [(_ suite-name setup teardown test ...)
     (let make-suite-proc ([a-suit-name suite-name] 
                           [a-setup (lambda () setup)] 
                           [a-teardown (lambda () teardown)]
                           [tests (list test ...)])
       (apply make-test-suite
              a-suit-name
              (map 
               (lambda (t-case)
                 (match t-case
                   [($ test-case name action)
                    (make-test-case name (action) (a-setup) (a-teardown))]
                   [($ test-suite name tests) ;;; apply setup/teardown
recursively
                    (apply make-test-suite
                           name
                           (map
                            (lambda (t-case)
                              (match t-case
                                [($ test-case iname iaction)
                                 (make-test-case iname (iaction) (a-setup)
(a-teardown))]  
                                [($ test-suite iname itests)
                                 (make-suite-proc iname a-setup a-teardown
itests)]))
                            tests))]))
               tests)))]))

;;; simple illustration
(test/text-ui
 (make-test-suite+
  "Setup/teardown"
  (display "setup\n")
  (display "teardown\n")
  (make-test-case
   "case1"
   (display "action1\n"))
  (make-test-case
   "case2"
   (display "action2\n"))
  (make-test-case
   "case3"
   (display "action3\n")
   (display "action3 own setup\n")
   (display "action3 own teardown\n")
   )
  (make-test-suite
   "enclosed"
   (make-test-case
    "enclosed-case"
    (display "enclosed action\n")))
  (make-test-suite+
   "enclosed+"
   (display "\tsub-setup\n")
   (display "\tsub-teardown\n")
   (make-test-case
    "enclosed-case+"
    (display "\tenclosed action+\n"))
   (make-test-suite+
    "enclosed++"
    (display "\tsub-sub-setup\n")
    (display "\tsub-sub-teardown\n")
    (make-test-case
     "enclosed-case++"
     (display "\tenclosed action++\n"))
    (make-test-case
     "enclosed-case++ #2"
     (display "\tenclosed action++ #2\n")))
   (make-test-suite
    "enclosed++ w/o setup"
    (make-test-case
     "enclosed-case++ w/o setup"
     (display "\tenclosed action++ w/o setup\n"))))))

-- 
Sergey Khorev
http://iamphet.nm.ru
PREFERENCE, n.  A sentiment, or frame of mind, induced by the
erroneous belief that one thing is better than another.
    An ancient philosopher, expounding his conviction that life is no
better than death, was asked by a disciple why, then, he did not die.
"Because," he replied, "death is no better than life."
    It is longer.
 -- Ambrose Bierce, "The Devil's Dictionary"



-------------------------------------------------------
This SF.Net email sponsored by: ApacheCon 2003,
16-19 November in Las Vegas. Learn firsthand the latest
developments in Apache, PHP, Perl, XML, Java, MySQL,
WebDAV, and more! http://www.apachecon.com/
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.