racket/collects/web-server/tests/lang/defun-test.ss
2008-02-24 21:27:36 +00:00

27 lines
1.1 KiB
Scheme

#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(lib "defun.ss" "web-server" "lang")
(lib "util.ss" "web-server" "lang"))
(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?]))))))))
))