diff options
Diffstat (limited to 'tests/011/patmatch.tl')
| -rw-r--r-- | tests/011/patmatch.tl | 233 |
1 files changed, 122 insertions, 111 deletions
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 6cb00157..f7055602 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -1,28 +1,31 @@ (load "../common") -(test (if-match 1 1 'yes 'no) yes) -(test (if-match 1 0 'yes 'no) no) +(mtest + (if-match 1 1 'yes 'no) yes + (if-match 1 0 'yes 'no) no) (test (let ((sym 'a)) (list (if-match a sym 'yes 'no) (if-match b sym 'yes 'no))) (yes no)) -(test (when-match @a 42 (list a)) (42)) -(test (when-match (@nil) '(1) 'yes) yes) -(test (when-match (@a @b @c) '(1 2 3) (list c b a)) (3 2 1)) -(test (if-match (@a @b @c . @d) '(1 2 3 . 4) (list d c b a)) (4 3 2 1)) +(mtest + (when-match @a 42 (list a)) (42) + (when-match (@nil) '(1) 'yes) yes + (when-match (@a @b @c) '(1 2 3) (list c b a)) (3 2 1) + (if-match (@a @b @c . @d) '(1 2 3 . 4) (list d c b a)) (4 3 2 1)) (test (if-match (@(oddp @a) @b @c . @d) '(2 x y z) (list a b c d) :no-match) :no-match) -(test (if-match (1 2 . @a) '(1 2 3 4) a) (3 4)) -(test (if-match ((1 2 @a) @b) '((1 2 3) 4) (list a b)) (3 4)) -(test (if-match #() #() :yes :no) :yes) -(test (if-match #() #(1) :yes :no) :no) -(test (if-match #((1 @a) #(3 @b)) #((1 2) #(3 4)) (list a b)) (2 4)) +(mtest + (if-match (1 2 . @a) '(1 2 3 4) a) (3 4) + (if-match ((1 2 @a) @b) '((1 2 3) 4) (list a b)) (3 4) + (if-match #() #() :yes :no) :yes + (if-match #() #(1) :yes :no) :no + (if-match #((1 @a) #(3 @b)) #((1 2) #(3 4)) (list a b)) (2 4)) (test (when-match @(struct time year 2021 month @m) #S(time year 2021 month 1) m) @@ -43,8 +46,9 @@ ^((,(find-struct-type 'grommet) :grom) (,(find-struct-type 'widget) :widg))) -(test (when-match @(as w (@a @b @c)) '(1 2 3) (list w a b c)) ((1 2 3) 1 2 3)) -(test (when-match @(require (+ @a @b) (equal a b)) '(+ z z) (list a b)) (z z)) +(mtest + (when-match @(as w (@a @b @c)) '(1 2 3) (list w a b c)) ((1 2 3) 1 2 3) + (when-match @(require (+ @a @b) (equal a b)) '(+ z z) (list a b)) (z z)) (test (if-match @(require (+ @a @b) (equal a b)) '(+ y z) (list a b) @@ -90,27 +94,22 @@ (test (when-match (@(oddp) @(all @x)) '(2 (1 2 . 3)) x) nil) -(test (if-match @(or (@x 3 3) (1 @x 3) (1 2 @x)) '(1 2 3) x) 2) -(test (if-match @(<= 10 @a 13) 11 :yes :no) :yes) -(test (when-match @(as x @(<= 10 @a 13)) 11 x) 11) -(test (when-match (@(evenp) @(oddp @x)) '(2 3) x) 3) -(test (when-match @(<= 1 @x 10) 4 x) 4) -(test (when-match @(@d (chr-digit @c)) #\5 (list d c)) (5 #\5)) -(test (when-match @(or @(require @a (oddp a)) @b @c) 2 (list a b c)) - (nil 2 nil)) -(test (when-match @(@x (< . @sym)) '(1 2 3) (list x sym)) - (t (1 2 3))) -(test (when-match @(@x (< . @sym)) '(3 2 1) (list x sym)) - nil) -(test (let ((x t)) - (when-match @(@x (< . @sym)) '(1 2 3) (list x sym))) - (t (1 2 3))) -(test (let ((x nil)) - (when-match @(@x (< . @sym)) '(1 2 3) (list x sym))) - nil) - -(test (if-match (@(or @a) @a) '(1 2) a :no) :no) -(test (if-match (@(and @a) @a) '(1 2) a :no) :no) +(mtest + (if-match @(or (@x 3 3) (1 @x 3) (1 2 @x)) '(1 2 3) x) 2 + (if-match @(<= 10 @a 13) 11 :yes :no) :yes + (when-match @(as x @(<= 10 @a 13)) 11 x) 11 + (when-match (@(evenp) @(oddp @x)) '(2 3) x) 3 + (when-match @(<= 1 @x 10) 4 x) 4 + (when-match @(@d (chr-digit @c)) #\5 (list d c)) (5 #\5) + (when-match @(or @(require @a (oddp a)) @b @c) 2 (list a b c)) (nil 2 nil) + (when-match @(@x (< . @sym)) '(1 2 3) (list x sym)) (t (1 2 3)) + (when-match @(@x (< . @sym)) '(3 2 1) (list x sym)) nil + (let ((x t)) + (when-match @(@x (< . @sym)) '(1 2 3) (list x sym))) (t (1 2 3)) + (let ((x nil)) + (when-match @(@x (< . @sym)) '(1 2 3) (list x sym))) nil + (if-match (@(or @a) @a) '(1 2) a :no) :no + (if-match (@(and @a) @a) '(1 2) a :no) :no) (test @@ -187,17 +186,19 @@ (test (when-match @(hash (x @y) (@(symbolp @y) @datum)) #H(() (x k) (k 42)) datum) (42)) -(test (if-match #R(10 20) 10..20 :yes :no) :yes) -(test (if-match #R(10 20) #R(10 20) :yes :no) :yes) -(test (if-match #R(10 20) #R(1 2) :yes :no) :no) -(test (when-match #R(@a @b) 1..2 (list a b)) (1 2)) -(test (when-match #R(@a 2) 1..2 a) 1) -(test (when-match #R(1 @a) 1..2 a) 2) -(test (when-match #R(2 @a) 1..2 a) nil) -(test (when-match #R(@a 1) 1..2 a) nil) +(mtest + (if-match #R(10 20) 10..20 :yes :no) :yes + (if-match #R(10 20) #R(10 20) :yes :no) :yes + (if-match #R(10 20) #R(1 2) :yes :no) :no + (when-match #R(@a @b) 1..2 (list a b)) (1 2) + (when-match #R(@a 2) 1..2 a) 1 + (when-match #R(1 @a) 1..2 a) 2 + (when-match #R(2 @a) 1..2 a) nil + (when-match #R(@a 1) 1..2 a) nil) -(test (when-match @a..@b '1..2 (list a b)) (1 2)) -(test (when-match (rcons @a @b) '(rcons 1 2) (list a b)) (1 2)) +(mtest + (when-match @a..@b '1..2 (list a b)) (1 2) + (when-match (rcons @a @b) '(rcons 1 2) (list a b)) (1 2)) (test (let ((h #H(() (a 1) (b 2)))) (when-match @[h @x] 'a x)) @@ -244,27 +245,30 @@ ((1) 1) ((@x) (+ (fib (pred x)) (fib (ppred x))))) -(test (fib 0) 1) -(test (fib 1) 1) -(test (fib 2) 2) -(test (fib 3) 3) -(test (fib 4) 5) -(test (fib 5) 8) +(mtest + (fib 0) 1 + (fib 1) 1 + (fib 2) 2 + (fib 3) 3 + (fib 4) 5 + (fib 5) 8) (defun-match ack ((0 @n) (+ n 1)) ((@m 0) (ack (- m 1) 1)) ((@m @n) (ack (- m 1) (ack m (- n 1))))) -(test (ack 1 1) 3) -(test (ack 2 2) 7) +(mtest + (ack 1 1) 3 + (ack 2 2) 7) (defun x-x-y (list x) (when-match (@x @x @y) list y)) -(test (x-x-y '(1 1 2) 1) 2) -(test (x-x-y '(1 2 3) 1) nil) -(test (x-x-y '(1 1 2 r2) 1) nil) +(mtest + (x-x-y '(1 1 2) 1) 2 + (x-x-y '(1 2 3) 1) nil + (x-x-y '(1 1 2 r2) 1) nil) (test (let ((a 3) (x 0)) (match-case '(3 2 1) @@ -298,12 +302,13 @@ (list x y z)) (abc (3 4 def 5 . 6) def)) -(test (when-match @(sme (1 2) (2 3) (4)) '(1 2 3 4) t) nil) -(test (when-match @(sme (1 2) (3 4) (4)) '(1 2 3 4) t) nil) -(test (when-match @(sme (1 2) (2 3) (3 4)) '(1 2 3 4) t) nil) -(test (when-match @(sme (1 2 . @x) (3 . @y) (4)) '(1 2 3 4) t) t) -(test (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4) t) t) -(test (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4 . 5) t) nil) +(mtest + (when-match @(sme (1 2) (2 3) (4)) '(1 2 3 4) t) nil + (when-match @(sme (1 2) (3 4) (4)) '(1 2 3 4) t) nil + (when-match @(sme (1 2) (2 3) (3 4)) '(1 2 3 4) t) nil + (when-match @(sme (1 2 . @x) (3 . @y) (4)) '(1 2 3 4) t) t + (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4) t) t + (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4 . 5) t) nil) (test (when-match @(sme (1 @y) (@z @x @y @z) (@x @y)) '(1 2 3 1 2 3 1 2) (list x y z)) @@ -317,9 +322,10 @@ (test (when-match @(sme () () 5) 5 t) t) -(test (when-match @(end 3 x) 3 x) 3) -(test (when-match @(end (2 @x) y) '(1 2 3) (list x y)) (3 (2 3))) -(test (when-match @(end (2 . @x) y) '(1 2 . 3) (list x y)) (3 (2 . 3))) +(mtest + (when-match @(end 3 x) 3 x) 3 + (when-match @(end (2 @x) y) '(1 2 3) (list x y)) (3 (2 3)) + (when-match @(end (2 . @x) y) '(1 2 . 3) (list x y)) (3 (2 . 3))) (test (when-match @(as z @(end (2 @x) y)) '(1 2 3) (list x y z)) (3 (2 3) (1 2 3))) @@ -339,64 +345,69 @@ (test (when-match (@(var= a) @(var= a)) '(1 1.0) a) 1) -(test (when-match `` "" t) t) -(test (when-match `abc` "abc" t) t) -(test (when-match `@a` "abc" a) "abc") +(mtest + (when-match `` "" t) t + (when-match `abc` "abc" t) t + (when-match `@a` "abc" a) "abc") (macro-time-let ((*stderr* *stdnull*)) - (test (when-match `@a@b` "abc" a) :error) - (test (when-match `@nil@b` "abc" a) :error) - (test (when-match `@nil@nil` "abc" a) :error) - (test (when-match `@a@nil` "abc" a) :error)) - - -(test (when-match `@a-$` "a-$" a) "a") -(test (when-match `#@a-$` "#a-$" a) "a") -(test (when-match `#@a-$` "#a-$$" a) nil) -(test (when-match `#@a-$` "#a-" a) nil) -(test (when-match `#@a-@b` "#a-$" (list a b)) ("a" "$")) -(test (when-match `#@{a #/ab*c/}` "#abbbc" a) "abbbc") -(test (when-match `#@{a #/ab*c/}d` "#abbbcd" a) "abbbc") -(test (when-match `#@{a 3}@b` "#abb" a) "abb") -(test (when-match `#@{a 3}@b` "#abbbc" (list a b)) ("abb" "bc")) -(test (when-match `#@{a 4}@b` "#abb" a) nil) -(test (when-match `#@{a 3}` "#abb" a) "abb") -(test (when-match `#@{a 2}` "#abb" a) nil) -(test (when-match `#@{a 4}` "#abb" a) nil) + (mtest + (when-match `@a@b` "abc" a) :error + (when-match `@nil@b` "abc" a) :error + (when-match `@nil@nil` "abc" a) :error + (when-match `@a@nil` "abc" a) :error)) + +(mtest + (when-match `@a-$` "a-$" a) "a" + (when-match `#@a-$` "#a-$" a) "a" + (when-match `#@a-$` "#a-$$" a) nil + (when-match `#@a-$` "#a-" a) nil + (when-match `#@a-@b` "#a-$" (list a b)) ("a" "$") + (when-match `#@{a #/ab*c/}` "#abbbc" a) "abbbc" + (when-match `#@{a #/ab*c/}d` "#abbbcd" a) "abbbc" + (when-match `#@{a 3}@b` "#abb" a) "abb" + (when-match `#@{a 3}@b` "#abbbc" (list a b)) ("abb" "bc") + (when-match `#@{a 4}@b` "#abb" a) nil + (when-match `#@{a 3}` "#abb" a) "abb" + (when-match `#@{a 2}` "#abb" a) nil + (when-match `#@{a 4}` "#abb" a) nil) (let ((z 0)) - (test (when-match `@z#@a-$` "0#a-$" a) "a") - (test (when-match `@z#@a-$` "0#a-$$" a) nil) - (test (when-match `@z#@a-$` "0#a-" a) nil) - (test (when-match `@z#@a-@b` "0#a-$" (list a b)) ("a" "$")) - (test (when-match `@z#@{a #/ab*c/}` "0#abbbc" a) "abbbc") - (test (when-match `@z#@{a #/ab*c/}d` "0#abbbcd" a) "abbbc") - (test (when-match `@z#@{a 3}@b` "0#abb" a) "abb") - (test (when-match `@z#@{a 3}@b` "0#abbbc" (list a b)) ("abb" "bc")) - (test (when-match `@z#@{a 4}@b` "0#abb" a) nil) - (test (when-match `@z#@{a 3}` "0#abb" a) "abb") - (test (when-match `@z#@{a 2}` "0#abb" a) nil) - (test (when-match `@z#@{a 4}` "0#abb" a) nil)) + (mtest + (when-match `@z#@a-$` "0#a-$" a) "a" + (when-match `@z#@a-$` "0#a-$$" a) nil + (when-match `@z#@a-$` "0#a-" a) nil + (when-match `@z#@a-@b` "0#a-$" (list a b)) ("a" "$") + (when-match `@z#@{a #/ab*c/}` "0#abbbc" a) "abbbc" + (when-match `@z#@{a #/ab*c/}d` "0#abbbcd" a) "abbbc" + (when-match `@z#@{a 3}@b` "0#abb" a) "abb" + (when-match `@z#@{a 3}@b` "0#abbbc" (list a b)) ("abb" "bc") + (when-match `@z#@{a 4}@b` "0#abb" a) nil + (when-match `@z#@{a 3}` "0#abb" a) "abb" + (when-match `@z#@{a 2}` "0#abb" a) nil + (when-match `@z#@{a 4}` "0#abb" a) nil)) (macro-time-let ((*stderr* *stdnull*)) (test (when-match `#@{a 4 5}` "#abb" a) :error)) (let ((b "bcd")) - (test (when-match `@a@b` "abcd" a) "a") - (test (when-match `@a@{b [1..:]}` "acd" a) "a") - (test (when-match `@a@{b [1..:]}` "abcd" a) "ab") - (test (when-match `@a@{b [0..1]}` "abcd" a) nil) - (test (when-match `@a@{b [0..2]}d` "abcd" a) "a")) + (mtest + (when-match `@a@b` "abcd" a) "a" + (when-match `@a@{b [1..:]}` "acd" a) "a" + (when-match `@a@{b [1..:]}` "abcd" a) "ab" + (when-match `@a@{b [0..1]}` "abcd" a) nil + (when-match `@a@{b [0..2]}d` "abcd" a) "a")) (let ((x 123) (z 0)) - (test (when-match `^@{x 5}$` "^123 $" t) t) - (test (when-match `^@{x -5}$` "^ 123$" t) t) - (test (when-match `@x@x` "123123" t) t) - (test (when-match `@x@{x [1..:]}` "12323" t) t) - (test (when-match `@z^@{x 5}$` "0^123 $" t) t) - (test (when-match `@z^@{x -5}$` "0^ 123$" t) t) - (test (when-match `@z@x@x` "0123123" t) t) - (test (when-match `@z@x@{x [1..:]}` "012323" t) t)) + (mtest + (when-match `^@{x 5}$` "^123 $" t) t + (when-match `^@{x -5}$` "^ 123$" t) t + (when-match `@x@x` "123123" t) t + (when-match `@x@{x [1..:]}` "12323" t) t + (when-match `@z^@{x 5}$` "0^123 $" t) t + (when-match `@z^@{x -5}$` "0^ 123$" t) t + (when-match `@z@x@x` "0123123" t) t + (when-match `@z@x@{x [1..:]}` "012323" t) t)) (let ((a "$")) (test (when-match `@a-@b` "$-@" b) "@")) |