unlib/syntax-test.ss at master · untyped/unlib · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#lang scheme/base

(require "test-base.ss")

(require (for-syntax scheme/base
                     "syntax.ss"))

(define/provide-test-suite syntax-tests

  (test-case "dotted-identifier?"
    (let-syntax ([dotted?
                  (lambda (stx)
                    (datum->syntax
                     stx
                     (syntax-case stx ()
                       [(_ id)         (dotted-identifier? #'id)]
                       [(_ id min)     (dotted-identifier?
                                        #'id
                                        (syntax->datum #'min))]
                       [(_ id min max) (dotted-identifier?
                                        #'id
                                        (syntax->datum #'min)
                                        (syntax->datum #'max))])))])
      (check-false (dotted? a))
      (check-true  (dotted? a 1))
      (check-true  (dotted? a 1 1))

      (check-true  (dotted? a.b))
      (check-true  (dotted? a.b 2))
      (check-true  (dotted? a.b 2 3))
      (check-true  (dotted? a.b 1 2))
      (check-false (dotted? a.b 1 1))
      (check-false (dotted? a.b 3 3))

      (check-true  (dotted? .a.b))
      (check-true  (dotted? a..b))
      (check-true  (dotted? a.b.))
      (check-true  (dotted? a.b.c))))

  (test-case "simple-dotted-identifier?"
    (let-syntax ([dotted?
                  (lambda (stx)
                    (datum->syntax
                     stx
                     (syntax-case stx ()
                       [(_ id)         (simple-dotted-identifier? #'id)]
                       [(_ id min)     (simple-dotted-identifier?
                                        #'id
                                        (syntax->datum #'min))]
                       [(_ id min max) (simple-dotted-identifier?
                                        #'id
                                        (syntax->datum #'min)
                                        (syntax->datum #'max))])))])
      (check-false (dotted? a))
      (check-true  (dotted? a.b))
      (check-false (dotted? .a.b))
      (check-false (dotted? a..b))
      (check-false (dotted? a.b.))
      (check-true  (dotted? a.b.c))
      (check-false (dotted? a.b.c 2 2))))

  (test-case "dotted-identifier-count"
    (let-syntax ([count
                  (lambda (stx)
                    (datum->syntax
                     stx
                     (syntax-case stx ()
                       [(_ id) (dotted-identifier-count #'id)])))])
      (check-equal? (count a)     1)
      (check-equal? (count a.)    2)
      (check-equal? (count .a)    2)
      (check-equal? (count a.b)   2)
      (check-equal? (count a..b)  3)
      (check-equal? (count a.b.c) 3)))

  (test-case "dotted-identifier-split"
    (let-syntax ([split
                  (lambda (stx)
                    (syntax-case stx ()
                      [(_ id) #`(list #,@(dotted-identifier-split #'id))]))])
      (let ([a 1] [b 2] [c 3])
        (check-equal? (split a)     (list 1))
        (check-equal? (split a.b)   (list 1 2))
        (check-equal? (split a.b.c) (list 1 2 3))))))