Fixed code coverate in tests

This commit is contained in:
Georges Dupéron 2016-09-21 19:39:21 +02:00
parent f425719cca
commit e2176be9f4
2 changed files with 250 additions and 217 deletions

View File

@ -1,30 +1,47 @@
#lang typed/racket
(require xlist/untyped
typed/rackunit)
typed/rackunit
"ck.rkt")
(define-syntax-rule (check-match v clause result)
(check-equal? (let ([no-match (gensym 'no-match)])
(match v clause [_ no-match]))
result))
(define-syntax-rule (check-not-match v pat)
(let ([no-match (gensym 'no-match)])
(check-equal? (match v pat [_ no-match])
no-match)))
(define-syntax-rule (check-match? v pat)
(check-true (match v [pat #t] [_ #f])))
(define-syntax-rule (check-not-match? v pat)
(check-false (match v [pat #t] [_ #f])))
(test-begin
"(xlist 1 2 3 4 5)"
(check-true (match '() [(xlist) #t] [_ #f]))
(check-true (match '(1) [(xlist 1) #t] [_ #f]))
(check-true (match '(1 2) [(xlist 1 2) #t] [_ #f]))
(check-true (match '(1 2 3) [(xlist 1 2 3) #t] [_ #f]))
(check-true (match '(1 2 3 4) [(xlist 1 2 3 4) #t] [_ #f]))
(check-true (match '(1 2 3 4 5) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-match? '() (xlist))
(check-match? '(1) (xlist 1))
(check-match? '(1 2) (xlist 1 2))
(check-match? '(1 2 3) (xlist 1 2 3))
(check-match? '(1 2 3 4) (xlist 1 2 3 4))
(check-match? '(1 2 3 4 5) (xlist 1 2 3 4 5))
(check-false (match '() [(xlist 1) #t] [_ #f]))
(check-false (match '(1) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4 5 6) #t] [_ #f]))
(check-not-match? '() (xlist 1))
(check-not-match? '(1) (xlist 1 2))
(check-not-match? '(1 2) (xlist 1 2 3))
(check-not-match? '(1 2 3) (xlist 1 2 3 4))
(check-not-match? '(1 2 3 4) (xlist 1 2 3 4 5))
(check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4 5 6))
(check-false (match '(1) [(xlist) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4 5 6) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-not-match? '(1) (xlist))
(check-not-match? '(1 2) (xlist 1))
(check-not-match? '(1 2 3) (xlist 1 2))
(check-not-match? '(1 2 3 4) (xlist 1 2 3))
(check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4))
(check-not-match? '(1 2 3 4 5 6) (xlist 1 2 3 4 5))
(void))
;; Should fail:
@ -36,124 +53,124 @@
(test-begin
"(xlist 1 *) and (xlist 1 +) with or witout ^"
(check-true (match '() [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 *) #t] [_ #f]))
(check-match? '() (xlist 1 *))
(check-match? '(1) (xlist 1 *))
(check-match? '(1 1) (xlist 1 *))
(check-match? '(1 1 1) (xlist 1 *))
; NOT (check-true '() (xlist 1 +))
(check-true (match '(1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 +) #t] [_ #f]))
(check-not-match? '() (xlist 1 +))
(check-match? '(1) (xlist 1 +))
(check-match? '(1 1) (xlist 1 +))
(check-match? '(1 1 1) (xlist 1 +))
(check-true (match '() [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-match? '() (xlist 1 ^ *))
(check-match? '(1) (xlist 1 ^ *))
(check-match? '(1 1) (xlist 1 ^ *))
(check-match? '(1 1 1) (xlist 1 ^ *))
; NOT (check-true '() (xlist 1 ^ +))
(check-true (match '(1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-not-match? '() (xlist 1 ^ +))
(check-match? '(1) (xlist 1 ^ +))
(check-match? '(1 1) (xlist 1 ^ +))
(check-match? '(1 1 1) (xlist 1 ^ +))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^"
(check-equal? (match '() [(xlist (? number? n) *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1 1))
(check-match '() [(xlist (? number? n) *) n] '())
(check-match '(1) [(xlist (? number? n) *) n] '(1))
(check-match '(1 1) [(xlist (? number? n) *) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) *) n] '(1 1 1))
(check-false (match '() [(xlist (? number? n) +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-not-match '() [(xlist (? number? n) +) n])
(check-match '(1) [(xlist (? number? n) +) n] '(1))
(check-match '(1 1) [(xlist (? number? n) +) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1 1 ))
(check-match '() [(xlist (? number? n) ^ *) n] '())
(check-match '(1) [(xlist (? number? n) ^ *) n] '(1))
(check-match '(1 1) [(xlist (? number? n) ^ *) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ *) n] '(1 1 1 ))
(check-false (match '() [(xlist (? number? n) ^ +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-not-match '() [(xlist (? number? n) ^ +) n])
(check-match '(1) [(xlist (? number? n) ^ +) n] '(1))
(check-match '(1 1) [(xlist (? number? n) ^ +) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) something after"
(check-equal? (match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ()))
(check-match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ()))
(check-match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b")))
(check-match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ("b")))
(check-match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ("b" "b")))
(check-match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ()))
(check-match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-not-match '() [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-not-match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-not-match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b")))
(check-match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1 1) . ("b")))
(check-match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b" "b")))
(check-equal? (match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ()))
(check-match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ()))
(check-match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b")))
(check-match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ("b")))
(check-match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ("b" "b")))
(check-match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ()))
(check-match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-not-match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-not-match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-not-match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b")))
(check-match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1 1) . ("b")))
(check-match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b" "b")))
(void))
(test-begin
"(xlist (? number? n) ^ x +)"
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] [_ #f]) '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - y)"
(check-equal? (match '() [(xlist (? number? n) ^ -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ - ) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 - ) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-match '() [(xlist (? number? n) ^ -) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ -) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ 0 -) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ - ) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ - ) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ 0 - ) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1))
(check-match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1))
(check-match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1))
(check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1 1))
(check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - (? string? s))"
(check-equal? (match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '(() . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '(() . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(void))

View File

@ -3,28 +3,44 @@
(require xlist/untyped
rackunit)
(define-syntax-rule (check-match v clause result)
(check-equal? (let ([no-match (gensym 'no-match)])
(match v clause [_ no-match]))
result))
(define-syntax-rule (check-not-match v pat)
(let ([no-match (gensym 'no-match)])
(check-equal? (match v pat [_ no-match])
no-match)))
(define-syntax-rule (check-match? v pat)
(check-true (match v [pat #t] [_ #f])))
(define-syntax-rule (check-not-match? v pat)
(check-false (match v [pat #t] [_ #f])))
(test-begin
"(xlist 1 2 3 4 5)"
(check-true (match '() [(xlist) #t] [_ #f]))
(check-true (match '(1) [(xlist 1) #t] [_ #f]))
(check-true (match '(1 2) [(xlist 1 2) #t] [_ #f]))
(check-true (match '(1 2 3) [(xlist 1 2 3) #t] [_ #f]))
(check-true (match '(1 2 3 4) [(xlist 1 2 3 4) #t] [_ #f]))
(check-true (match '(1 2 3 4 5) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-match? '() (xlist))
(check-match? '(1) (xlist 1))
(check-match? '(1 2) (xlist 1 2))
(check-match? '(1 2 3) (xlist 1 2 3))
(check-match? '(1 2 3 4) (xlist 1 2 3 4))
(check-match? '(1 2 3 4 5) (xlist 1 2 3 4 5))
(check-false (match '() [(xlist 1) #t] [_ #f]))
(check-false (match '(1) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4 5 6) #t] [_ #f]))
(check-not-match? '() (xlist 1))
(check-not-match? '(1) (xlist 1 2))
(check-not-match? '(1 2) (xlist 1 2 3))
(check-not-match? '(1 2 3) (xlist 1 2 3 4))
(check-not-match? '(1 2 3 4) (xlist 1 2 3 4 5))
(check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4 5 6))
(check-false (match '(1) [(xlist) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4 5 6) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-not-match? '(1) (xlist))
(check-not-match? '(1 2) (xlist 1))
(check-not-match? '(1 2 3) (xlist 1 2))
(check-not-match? '(1 2 3 4) (xlist 1 2 3))
(check-not-match? '(1 2 3 4 5) (xlist 1 2 3 4))
(check-not-match? '(1 2 3 4 5 6) (xlist 1 2 3 4 5))
(void))
;; Should fail:
@ -36,124 +52,124 @@
(test-begin
"(xlist 1 *) and (xlist 1 +) with or witout ^"
(check-true (match '() [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 *) #t] [_ #f]))
(check-match? '() (xlist 1 *))
(check-match? '(1) (xlist 1 *))
(check-match? '(1 1) (xlist 1 *))
(check-match? '(1 1 1) (xlist 1 *))
; NOT (check-true '() (xlist 1 +))
(check-true (match '(1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 +) #t] [_ #f]))
(check-not-match? '() (xlist 1 +))
(check-match? '(1) (xlist 1 +))
(check-match? '(1 1) (xlist 1 +))
(check-match? '(1 1 1) (xlist 1 +))
(check-true (match '() [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-match? '() (xlist 1 ^ *))
(check-match? '(1) (xlist 1 ^ *))
(check-match? '(1 1) (xlist 1 ^ *))
(check-match? '(1 1 1) (xlist 1 ^ *))
; NOT (check-true '() (xlist 1 ^ +))
(check-true (match '(1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-not-match? '() (xlist 1 ^ +))
(check-match? '(1) (xlist 1 ^ +))
(check-match? '(1 1) (xlist 1 ^ +))
(check-match? '(1 1 1) (xlist 1 ^ +))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^"
(check-equal? (match '() [(xlist (? number? n) *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1 1))
(check-match '() [(xlist (? number? n) *) n] '())
(check-match '(1) [(xlist (? number? n) *) n] '(1))
(check-match '(1 1) [(xlist (? number? n) *) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) *) n] '(1 1 1))
(check-false (match '() [(xlist (? number? n) +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-not-match '() [(xlist (? number? n) +) n])
(check-match '(1) [(xlist (? number? n) +) n] '(1))
(check-match '(1 1) [(xlist (? number? n) +) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1 1 ))
(check-match '() [(xlist (? number? n) ^ *) n] '())
(check-match '(1) [(xlist (? number? n) ^ *) n] '(1))
(check-match '(1 1) [(xlist (? number? n) ^ *) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ *) n] '(1 1 1 ))
(check-false (match '() [(xlist (? number? n) ^ +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-not-match '() [(xlist (? number? n) ^ +) n])
(check-match '(1) [(xlist (? number? n) ^ +) n] '(1))
(check-match '(1 1) [(xlist (? number? n) ^ +) n] '(1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) something after"
(check-equal? (match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ()))
(check-match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ()))
(check-match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b")))
(check-match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1) . ("b")))
(check-match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ("b" "b")))
(check-match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] '((1 1 1) . ()))
(check-match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-not-match '() [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-not-match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-not-match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)])
(check-match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b")))
(check-match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1 1) . ("b")))
(check-match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] '((1) . ("b" "b")))
(check-equal? (match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ()))
(check-match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ()))
(check-match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b")))
(check-match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1) . ("b")))
(check-match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ("b" "b")))
(check-match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '((1 1 1) . ()))
(check-match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-not-match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-not-match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-not-match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)])
(check-match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b")))
(check-match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1 1) . ("b")))
(check-match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] '((1) . ("b" "b")))
(void))
(test-begin
"(xlist (? number? n) ^ x +)"
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] [_ #f]) '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - y)"
(check-equal? (match '() [(xlist (? number? n) ^ -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ - ) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 - ) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - ) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-match '() [(xlist (? number? n) ^ -) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ -) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ 0 -) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ - ) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ - ) n] '(1 1 1))
(check-match '() [(xlist (? number? n) ^ 0 - ) n] '())
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 1 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 2 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 - ) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1))
(check-match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1))
(check-match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1))
(check-match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1))
(check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] '(1 1 1 1 1))
(check-match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] '(1 1 1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - (? string? s))"
(check-equal? (match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '(() . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '(() . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(check-match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] '((1 1 1) . "b"))
(void))