suzanne.soy/extensible-parser-specifications
1
0
Fork 0
Code Issues 2 Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed structure-options2b-test.rkt

Browse Source
This commit is contained in:
Georges Dupéron 2016-08-26 22:39:59 +02:00
parent c927ae2e3b
commit cd2005e9af
2 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
structure-options2b-test.rkt
View File

@ -12,36 +12,45 @@
racket/format)) racket/format))
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~once {~global-counter cnt 'occurrencea #:kw}} [({~no-order {~once {~global-counter [cnt 'occurrencea] #:kw}}
{~global-counter cnt 'occurrenceb :number} {~global-counter [cnt 'occurrenceb] :number}
"ab"}) "ab"})
(attribute cnt)]) (attribute cnt)])
5) 5)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~once {~global-or kw-or-number #t #:kw}} [({~no-order {~once {~global-or kw-or-number #:kw}}
{~global-or kw-or-number #t :number} {~global-or kw-or-number :number}
"ab"}) "ab"})
(attribute kw-or-number)]) (attribute kw-or-number)])
#t) #t)
(check-equal? (syntax-parse #'(1 "ab" "ab" 3 4 5) (check-equal? (syntax-parse #'(1 "ab" "ab" 3 4 5)
[({~no-order {~optional {~global-or kw #t #:kw}} [({~no-order {~optional {~global-or [kw #t] #:kw}}
{~global-or kw #f :number} {~global-or [kw #f] :number}
"ab"}) "ab"})
(attribute kw)]) (attribute kw)])
#f) #f)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~optional {~global-and kw-and-not-number #t #:kw}} [({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and kw-and-not-number #f :number} {~global-and [kw-not-number #f] :number}
"ab"}) "ab"})
(attribute kw-and-not-number)]) (attribute kw-not-number)])
#f) #f)
(check-equal? (syntax-parse #'("ab" #:kw "ab") (check-equal? (syntax-parse #'("ab" "ab")
[({~no-order {~optional {~global-and kw-and-not-number #t #:kw}} [({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and kw-and-not-number #f :number} {~global-and [kw-not-number #f] :number}
"ab"}) "ab"})
(attribute kw-and-not-number)]) (attribute kw-not-number)])
;; (and) of nothing is #t, but we provide a 'none value
;; for this special case
'none)
(check-equal? (syntax-parse #'("ab" #:kw "ab")
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
#t) #t)

3
structure-options2b.rkt
View File

@ -179,8 +179,9 @@
(define (aggregate-global-and . bs) (define (aggregate-global-and . bs)
(andmap unbox ;; remove the layer of protection (andmap unbox ;; remove the layer of protection
(cons (box-immutable 'none) ;; default value when no bindings matched
(filter identity ;; remove failed bindings (filter identity ;; remove failed bindings
(flatten bs)))) ;; don't care about ellipsis nesting (flatten bs))))) ;; don't care about ellipsis nesting
(define-~global ~global-and aggregate-global-and) (define-~global ~global-and aggregate-global-and)
(define (aggregate-global-counter . bs) (define (aggregate-global-counter . bs)