www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | Submodules | README | LICENSE

test-format-id-record.rkt (2932B)

      1 #lang racket
      2 
      3 (require (for-syntax "../untyped-only/format-id-record.rkt"
      4                      racket/syntax
      5                      racket/string
      6                      racket/function)
      7          rackunit)
      8 
      9 (define-syntax (test-hyphen stx)
     10   (syntax-case stx ()
     11     [(_ [a ...] b)
     12      (with-sub-range-binders
     13       #`(begin (define #,(apply format-id/record
     14                                 (car (syntax->list #'(a ...)))
     15                                 (string-join (map (const "~a")
     16                                                   (syntax->list #'(a ...)))
     17                                              "-")
     18                                 (syntax->list #'(a ...)))
     19                  123)
     20                (check-equal? b 123)))]))
     21 
     22 (test-hyphen [a b c xyz] a-b-c-xyz)
     23 (let ()
     24   (test-hyphen [a b c xyz] a-b-c-xyz))
     25 
     26 (define-syntax (test-concat stx)
     27   (syntax-case stx ()
     28     [(_ [a b c] d)
     29      (with-sub-range-binders
     30       #`(begin (define #,(format-id/record #'a "~a~a~a" #'a #'b #'c)
     31                  9)
     32                (check-equal? d 9)))]))
     33 
     34 (test-concat [a bb ccc] abbccc)
     35 ;; Misaligned sub-range-binders are due to
     36 ;; https://github.com/racket/drracket/issues/68
     37 (test-concat [1 81 6561] |1816561|)
     38 (let ()
     39   (test-concat [a bb ccc] abbccc)
     40   (test-concat [1 81 6561] |1816561|))
     41 
     42 
     43 (define-syntax (test-arrows stx)
     44   (syntax-case stx ()
     45     [(_ [a b c] d e)
     46      (with-arrows
     47       #`(begin (define #,(format-id/record #'a "~a~a~a" #'a #'b #'c)
     48                  321)
     49                (check-equal? d #,(syntax-local-value/record #'e number?))))]))
     50 
     51 (define-syntax the-e 321)
     52 (test-arrows [xxx yy z] xxxyyz the-e)
     53 
     54 (let ()
     55   (define-syntax the-e 321)
     56   (test-arrows [xxx yy z] xxxyyz the-e))
     57 
     58 ;; Does not work. I suspect that the 'sub-range-binders must have the exact same
     59 ;; scope as the bound identifier, but `let` introduces new scopes that the
     60 ;; identifiers within sub-range-binders won't have.
     61 (define-syntax (test-hyphen-let stx)
     62   (syntax-case stx ()
     63     [(_ [a ...] b)
     64      #`(let ()
     65          #,(with-sub-range-binders
     66             #`(begin
     67                 (define #,(apply format-id/record
     68                                  (car (syntax->list #'(a ...)))
     69                                  (string-join (map (const "~a")
     70                                                    (syntax->list #'(a ...)))
     71                                               "-")
     72                                  (syntax->list #'(a ...)))
     73                   123)
     74                 (check-equal? b 123))))]))
     75 
     76 (test-hyphen-let [a b c xyz2] a-b-c-xyz2)
     77 
     78 (define-syntax (test-fmt stx)
     79   (syntax-case stx ()
     80     [(_ fmt [a b c] d)
     81      (with-sub-range-binders
     82       #`(begin (define #,(format-id/record #'fmt #'fmt #'a #'b #'c)
     83                  9)
     84                (check-equal? d 9)))]))
     85 
     86 ;; Draws the following arrows:
     87 ;; w→w 1→1 x~~x→x~x 2→2 y→y 3→3 z→z
     88 ;; Nothing drawn from or to the "~a" themselves.
     89 (test-fmt "w~ax~~x~ay~az" [1 2 3] w1x~x2y3z)