www

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

test-stx.rkt (3717B)

      1 #lang typed/racket
      2 (require "../typed-untyped.rkt")
      3 (define-typed/untyped-test-module
      4   (require-typed/untyped "../typed-rackunit.rkt"
      5                          "../typed-rackunit-extensions.rkt"
      6                          "../stx.rkt")
      7 
      8   (check-ann #'() (Stx-List? (Syntaxof Number)))
      9   (check-ann #'(1) (Stx-List? (Syntaxof Number)))
     10   (check-ann #'(1 2 3) (Stx-List? (Syntaxof Number)))
     11   (check-ann #'(1 2 . ()) (Stx-List? (Syntaxof Number)))
     12   (check-ann #'(1 . (2 . (3 . ()))) (Stx-List? (Syntaxof Number)))
     13   (check-ann #'(1 . (2 3 . ())) (Stx-List? (Syntaxof Number)))
     14   (check-ann #'(1 2 . (3 4 . (5))) (Stx-List? (Syntaxof Number)))
     15 
     16   (test-begin
     17    (check-equal?: (match #'(1 2 3)
     18                     [(stx-list a b c) (list (syntax-e c)
     19                                             (syntax-e b)
     20                                             (syntax-e a))])
     21                   '(3 2 1))
     22       
     23    (check-equal?: (match #'(1 2 3)
     24                     [(stx-list a ...) (map (inst syntax-e Positive-Byte) a)])
     25                   '(1 2 3))
     26       
     27    #;(check-equal?: (match #`(1 . (2 3))
     28                       [(stx-list a b c) (list (syntax-e c)
     29                                               (syntax-e b)
     30                                               (syntax-e a))])
     31                     '(3 2 1)))
     32 
     33   (test-begin
     34    (check-equal? (match #'x [(stx-e s) s]) 'x)
     35    (check-equal? (match #'(x . y) [(stx-e (cons a b)) (cons (syntax-e b)
     36                                                             (syntax-e a))])
     37                  '(y . x)))
     38 
     39   (test-begin
     40    (check-equal? (match #'(x . y) [(stx-pair a b) (cons (syntax-e b)
     41                                                         (syntax-e a))])
     42                  '(y . x))
     43    (check-equal? (match #'(x y z) [(stx-pair a b) (cons (map syntax->datum b)
     44                                                         (syntax->datum a))])
     45                  '((y z) . x)))
     46 
     47   (test-begin
     48    (check-equal? (stx-null? #f) #f)
     49    (check-equal? (stx-null? 'a) #f)
     50    (check-equal? (stx-null? '()) #t)
     51    (check-equal? (stx-null? #'()) #t)
     52    (check-equal? (stx-null? #''()) #f)
     53    (check-equal? (stx-null? #'a) #f))
     54 
     55   (test-begin
     56    (check-equal? (syntax->datum
     57                   (ann (stx-cons #'a #'(b c))
     58                        (Syntaxof (Pairof (Syntaxof 'a)
     59                                          (Syntaxof (List (Syntaxof 'b)
     60                                                          (Syntaxof 'c)))))))
     61                  '(a b c))
     62       
     63    (check-equal? (syntax->datum
     64                   (ann (stx-cons #'1 (ann #'2 (Syntaxof 2)))
     65                        (Syntaxof (Pairof (Syntaxof 1)
     66                                          (Syntaxof 2)))))
     67                  '(1 . 2)))
     68 
     69   (test-begin
     70    (let ((y 3))
     71      (check-equal? (nameof y) 'y)))
     72 
     73   (define-syntax (skip<6.6 stx)
     74     (syntax-case stx ()
     75       [(_ . rest)
     76        (if (or (regexp-match #px"^6(\\.[012345](\\..*|)|)$" (version))
     77                (regexp-match #px"^[123245]\\..*$" (version)))
     78            #'(begin)
     79            #'(begin . rest))]))
     80   (skip<6.6
     81    (test-begin
     82     (check-ann (stx-e #'(a . b))
     83                (Pairof (Syntaxof 'a) (Syntaxof 'b)))
     84 
     85     (check-ann (stx-e `(,#'a . ,#'b))
     86                (Pairof (Syntaxof 'a) (Syntaxof 'b)))
     87    
     88     (check-ann (stx-e '(a . b))
     89                (Pairof 'a 'b))
     90 
     91     (check-ann (stx-e #'(a b . (c d)))
     92                (List* (Syntaxof 'a) (Syntaxof 'b)
     93                       (Syntaxof (List (Syntaxof 'c)
     94                                       (Syntaxof 'd)))))
     95 
     96     (check-ann (stx-e `(,#'a ,#'b . ,#'(c d)))
     97                (List* (Syntaxof 'a) (Syntaxof 'b)
     98                       (Syntaxof (List (Syntaxof 'c)
     99                                       (Syntaxof 'd))))))))