racket/collects/tests/unstable/define.rkt
2010-06-06 20:31:33 -04:00

86 lines
2.4 KiB
Racket

#lang racket
(require rackunit rackunit/text-ui racket/sandbox unstable/define "helpers.rkt")
(run-tests
(test-suite "define.ss"
(test-suite "at-end")
(test-suite "define-if-unbound"
(test
(let ()
(define-if-unbound very-special-name 1)
(define-if-unbound very-special-name 2)
(check-equal? very-special-name 1)))
(test
(let ()
(define-if-unbound (very-special-function) 1)
(define-if-unbound (very-special-function) 2)
(check-equal? (very-special-function) 1))))
(test-suite "define-values-if-unbound"
(test
(let ()
(define-values-if-unbound [very-special-name] 1)
(define-values-if-unbound [very-special-name] 2)
(check-equal? very-special-name 1))))
(test-suite "define-syntax-if-unbound"
(test
(let ()
(define-syntax-if-unbound very-special-macro
(lambda (stx) #'(quote 1)))
(define-syntax-if-unbound very-special-macro
(lambda (stx) #'(quote 2)))
(check-equal? (very-special-macro) 1)))
(test
(let ()
(define-syntax-if-unbound (very-special-macro stx)
#'(quote 1))
(define-syntax-if-unbound (very-special-macro stx)
#'(quote 2))
(check-equal? (very-special-macro) 1))))
(test-suite "define-syntaxes-if-unbound"
(test
(let ()
(define-syntaxes-if-unbound [very-special-macro]
(lambda (stx) #'(quote 1)))
(define-syntaxes-if-unbound [very-special-macro]
(lambda (stx) #'(quote 2)))
(check-equal? (very-special-macro) 1))))
(test-suite "define-renamings"
(test
(let ()
(define-renamings [with define] [fun lambda])
(with f (fun (x) (add1 x)))
(check-equal? (f 7) 8))))
(test-suite "declare-names"
(test
(let ()
(declare-names x y z)
(define-values [x y z] (values 1 2 3))
(check-equal? x 1)
(check-equal? y 2)
(check-equal? z 3))))
(test-suite "define-with-parameter"
(test
(let ()
(define p (make-parameter 0))
(define-with-parameter with-p p)
(with-p 7 (check-equal? (p) 7)))))
(test-suite "define-single-definition"
(test
(let ()
(define-single-definition with define-values)
(with x 0)
(check-equal? x 0))))
(test-suite "in-phase1")
(test-suite "in-phase1/pass2")))