racket/collects/tests/web-server/lang/defun-test.ss
2008-08-26 21:20:29 +00:00

27 lines
1.1 KiB
Scheme

#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
web-server/lang/defun
web-server/lang/util)
(provide defun-tests)
(define-syntax vwrap
(syntax-rules ()
[(_ e)
(call-with-values
(lambda () e)
(lambda x x))]))
(define defun-tests
(test-suite
"Defunctionalization"
; XXX Doesn't work for non-exp values
#;(test-not-exn "define-struct" (lambda () (vwrap (defun (expand (syntax (define-struct posn (x y))))))))
(test-not-exn "quote-syntax" (lambda () (vwrap (defun (expand (syntax #'provide/contract-id-set-a-date-day!))))))
#;(test-not-exn "provide/contract" (lambda () (vwrap (defun (expand (syntax (module t mzscheme
(require mzlib/contract)
(define x 1)
(provide/contract
[x integer?]))))))))
))