test-format-id-record-inject.rkt (1807B)
1 #lang racket 2 3 (require rackunit 4 (for-syntax phc-toolkit/untyped 5 racket/syntax 6 racket/string 7 racket/function 8 rackunit) 9 (for-meta 2 racket/base) 10 (for-meta 2 phc-toolkit/untyped)) 11 12 (define-syntax (foo stx) 13 (syntax-case stx () 14 [(_ a b) 15 (let () 16 (define/with-syntax a-b (format-id #'a "~a-~a" #'a #'b)) 17 ;#'(define a-b 42) 18 #'(inject-sub-range-formats ([#'a "~a-~a" #'a #'b]) 19 (define a-b 42)))])) 20 21 (foo x y) 22 23 ;; The arrows are properly drawn here. 24 (check-equal? x-y 42) 25 26 (define-syntax (bar stx) 27 (syntax-case stx () 28 [(_ a b) 29 (let () 30 (define/with-syntax a-b (format-id #'a "~a-~a" #'a #'b)) 31 #'(begin-for-syntax 32 (inject-sub-range-formats ([#'a "~a-~a" #'a #'b]) 33 (define a-b 42))))])) 34 35 (bar x y) 36 37 ;; The arrows are properly drawn here. 38 (begin-for-syntax (check-equal? x-y 42)) 39 40 (define-syntax (baz stx) 41 (syntax-case stx () 42 [(_ a b) 43 (with-format-ids/inject-binders 44 ([a-b #'a "~a-~a" #'a #'b]) 45 #'(begin-for-syntax 46 (inject-sub-range-binders ... 47 (define a-b 42))))])) 48 49 (baz x z) 50 51 ;; The arrows are properly drawn here. 52 (begin-for-syntax (check-equal? x-z 42)) 53 54 (define-syntax (test-hyphen-let stx) 55 (syntax-case stx () 56 [(_ [a b c] d e) 57 (with-format-ids/inject-binders 58 ([abc #'a "~a-~a-~a" #'a #'b #'c] 59 [ac #'a "~a++~a" #'a #'c]) 60 #`(let () 61 (inject-sub-range-binders ... 62 (define abc 123) 63 (define ac 456) 64 (check-equal? d 123) 65 (check-equal? e 456))))])) 66 67 ;; The arrows are properly drawn here. 68 (test-hyphen-let [a b c] 69 a-b-c a++c)