64 lines
2.8 KiB
Racket
64 lines
2.8 KiB
Racket
#lang racket
|
|
|
|
(require rackunit
|
|
stepper/private/shared
|
|
stepper/private/syntax-property)
|
|
|
|
; test cases taken from shared.rkt
|
|
;
|
|
(define (lifted-name sym)
|
|
(syntax->datum (get-lifted-var sym)))
|
|
(define cd-stx
|
|
(datum->syntax #f 'cd))
|
|
|
|
(check-equal? (lifted-name (datum->syntax #f 'ab)) 'lifter-ab-0)
|
|
(check-equal? (lifted-name cd-stx) 'lifter-cd-1)
|
|
(check-equal? (lifted-name (datum->syntax #f 'ef)) 'lifter-ef-2)
|
|
(check-equal? (lifted-name cd-stx) 'lifter-cd-1)
|
|
|
|
(check-equal? (map syntax-e (arglist->ilist #'(a b c))) '(a b c))
|
|
(check-equal? (map syntax-e (arglist->ilist #'(a . (b c)))) '(a b c))
|
|
(check-equal? (syntax-e (arglist->ilist #'a)) 'a)
|
|
(let ([result (arglist->ilist #' (a b . c))])
|
|
(check-equal? (syntax-e (car result)) 'a)
|
|
(check-equal? (syntax-e (cadr result)) 'b)
|
|
(check-equal? (syntax-e (cddr result)) 'c))
|
|
(check-equal? (map syntax-e (arglist-flatten #'(a b c))) '(a b c))
|
|
(check-equal? (map syntax-e (arglist-flatten #'(a . (b c)))) '(a b c))
|
|
(check-equal? (map syntax-e (arglist-flatten #'(a b . c))) '(a b c))
|
|
(check-equal? (map syntax-e (arglist-flatten #'a)) '(a))
|
|
|
|
(define new-queue (make-queue))
|
|
(check-equal? (queue-push new-queue 1) (void))
|
|
(check-equal? (queue-push new-queue 2) (void))
|
|
(check-equal? (queue-pop new-queue) 1)
|
|
(check-equal? (queue-push new-queue 3) (void))
|
|
(check-equal? (queue-pop new-queue) 2)
|
|
(check-equal? (queue-pop new-queue) 3)
|
|
(check-exn exn:fail? (lambda () (queue-pop new-queue)))
|
|
|
|
(check-equal?
|
|
(call-with-values (lambda ()
|
|
(values-map (lambda (a b) (values (+ a b) (- a b)))
|
|
`(1 2 3 4 5)
|
|
`(9 8 7 6 5)))
|
|
(lambda (sums diffs)
|
|
(list sums diffs)))
|
|
`((10 10 10 10 10)
|
|
(-8 -6 -4 -2 0)))
|
|
|
|
(check-exn exn:fail? (lambda () (stepper-syntax-property #`13 'boozle)))
|
|
(check-exn exn:fail? (lambda () (stepper-syntax-property #`13 'boozle #t)))
|
|
(check-equal? (stepper-syntax-property #`13 'stepper-hint) #f)
|
|
(check-equal? (stepper-syntax-property (stepper-syntax-property #`13 'stepper-hint 'yes)
|
|
'stepper-hint) 'yes)
|
|
(check-equal?
|
|
(stepper-syntax-property (stepper-syntax-property (stepper-syntax-property #`13
|
|
'stepper-hint
|
|
'no)
|
|
'stepper-hint 'yes)
|
|
'stepper-hint)
|
|
'yes)
|
|
(check-equal? (stepper-syntax-property (stepper-syntax-property (stepper-syntax-property #`13 'stepper-hint 'yes) 'stepper-black-box-expr 'arg) 'stepper-hint) 'yes)
|
|
(check-equal? (syntax->datum (stepper-syntax-property (stepper-syntax-property #`13 'stepper-hint 'yes) 'stepper-black-box-expr 'arg)) 13)
|