131 lines
5.4 KiB
Racket
131 lines
5.4 KiB
Racket
|
|
#lang scheme/base
|
|
(require "../gentest-framework.ss")
|
|
(provide proto:macros)
|
|
|
|
(define-tests proto:macros "Macros"
|
|
[#:suite
|
|
"Macros"
|
|
(test "id"
|
|
(id 'a)
|
|
[#:steps (macro 'a)]
|
|
#:no-hidden-steps)
|
|
(test "Tid"
|
|
(Tid 'a)
|
|
[#:steps (macro 'a)]
|
|
#:same-hidden-steps)
|
|
(test "pre-id"
|
|
(pre-id 'a)
|
|
[#:steps (macro (id 'a))
|
|
(macro 'a)]
|
|
#:no-hidden-steps)
|
|
(test "myor (base)"
|
|
(myor 'a)
|
|
[#:steps (macro 'a)]
|
|
#:no-hidden-steps)
|
|
(test "myor (recursive 1)"
|
|
(myor 'a 'b)
|
|
[#:steps (macro (let ((t 'a)) (if t t (myor 'b))))
|
|
(macro (let-values (((t) 'a)) (if t t (myor 'b))))
|
|
(rename-let-values (let-values (((t) 'a)) (if t t (myor 'b))))
|
|
(macro (let-values (((t) 'a)) (if t t 'b)))]
|
|
#:no-hidden-steps)
|
|
|
|
(test "leid with id"
|
|
(leid (id 'a))
|
|
[#:steps (macro 'a (leid (id 'a)))
|
|
(macro (#%expression 'a))]
|
|
#:no-hidden-steps)
|
|
(test "leid with Tid"
|
|
(leid (Tid 'a))
|
|
[#:steps (macro 'a (leid (Tid 'a)))
|
|
(macro (#%expression 'a))]
|
|
[#:hidden-steps (macro (leid 'a))])]
|
|
|
|
(test "lift"
|
|
(lift 'a)
|
|
[#:steps (remark local-lift 'a (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression
|
|
(#%top . #rx"^lifted"))))]
|
|
#:no-hidden-steps)
|
|
(test "lift with id"
|
|
(lift (id 'a))
|
|
[#:steps (remark local-lift (id 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (id 'a))
|
|
(#%expression (#%top . #rx"^lifted"))))
|
|
(macro (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression (#%top . #rx"^lifted"))))]
|
|
#:no-hidden-steps)
|
|
|
|
(test "lift with Tid"
|
|
(lift (Tid 'a))
|
|
[#:steps (remark local-lift (Tid 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (Tid 'a))
|
|
(#%expression (#%top . #rx"^lifted"))))
|
|
(macro (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression (#%top . #rx"^lifted"))))]
|
|
;; FIXME:
|
|
;; maybe don't show lifts, but do find (Tid 'a), show in orig ctx
|
|
;; but maybe not a good idea
|
|
#|
|
|
[#:hidden-steps (macro (lift 'a))]
|
|
|#)
|
|
|
|
(test "Tlift"
|
|
(Tlift 'a)
|
|
[#:steps (remark local-lift 'a (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression (#%top . #rx"^lifted"))))]
|
|
[#:hidden-steps (remark local-lift 'a (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression #rx"^lifted")))])
|
|
|
|
(test "Tlift with id"
|
|
(Tlift (id 'a))
|
|
[#:steps (remark local-lift (id 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (id 'a))
|
|
(#%expression (#%top . #rx"^lifted"))))
|
|
(macro (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression (#%top . #rx"^lifted"))))]
|
|
[#:hidden-steps (remark local-lift (id 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (id 'a))
|
|
(#%expression #rx"^lifted")))])
|
|
|
|
(test "Tlift with Tid"
|
|
(Tlift (Tid 'a))
|
|
[#:steps (remark local-lift (Tid 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(tag-top (#%expression (#%top . #rx"^lifted")))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (Tid 'a))
|
|
(#%expression (#%top . #rx"^lifted"))))
|
|
(macro (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression (#%top . #rx"^lifted"))))]
|
|
[#:steps (remark local-lift (Tid 'a) (#rx"^lifted"))
|
|
(macro (#%expression #rx"^lifted"))
|
|
(capture-lifts (begin (define-values (#rx"^lifted") (Tid 'a))
|
|
(#%expression #rx"^lifted")))
|
|
(macro (begin (define-values (#rx"^lifted") 'a)
|
|
(#%expression #rx"^lifted")))])
|
|
|
|
[#:suite "set! macros"
|
|
(test "set! (macro)"
|
|
(set! the-current-output-port 'a)
|
|
[#:steps
|
|
(macro (#%plain-app current-output-port 'a))]
|
|
#:no-hidden-steps)]
|
|
|
|
)
|