diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-18 07:27:17 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-18 07:27:17 -0800 |
commit | fb2f2c8ea44b56a089c685656bffa08bc63d8ac5 (patch) | |
tree | 1d0b7c94e3c453a4822ae5bd07bd2ce6aaac78b6 | |
parent | 262df61dea7cdb66b5dd50ef38f8e4ba672a596e (diff) | |
download | txr-fb2f2c8ea44b56a089c685656bffa08bc63d8ac5.tar.gz txr-fb2f2c8ea44b56a089c685656bffa08bc63d8ac5.tar.bz2 txr-fb2f2c8ea44b56a089c685656bffa08bc63d8ac5.zip |
matcher: add tests from documentation.
* tests/011/patmatch.tl: New file.
* tests/011/patmatch.expected: Likewise.
-rw-r--r-- | tests/011/patmatch.expected | 0 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 68 |
2 files changed, 68 insertions, 0 deletions
diff --git a/tests/011/patmatch.expected b/tests/011/patmatch.expected new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/tests/011/patmatch.expected diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl new file mode 100644 index 00000000..f930dd9f --- /dev/null +++ b/tests/011/patmatch.tl @@ -0,0 +1,68 @@ +(load "../common") + +(test (if-match 1 1 'yes 'no) yes) +(test (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 (@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)) + +(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)) + +(test (when-match @(struct time year 2021 month @m) #S(time year 2021 month 1) + m) + 1) + +(defstruct widget () + name + value) + +(defstruct grommet () + name + value) + +(vtest (append-each ((obj (list (new grommet name "foo" value :grom) + (new widget name "foo" value :widg)))) + (when-match @(struct @type name "foo" value @v) obj + (list (list type v)))) + ^((,(find-struct-type 'grommet) :grom) + (,(find-struct-type 'widget) :widg))) + +(test (when-match @(let 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)) + +(test (if-match @(require (+ @a @b) (equal a b)) '(+ y z) + (list a b) + :no-match) + :no-match) + +(test (when-match @(all (x @a @b)) '((x 1 a) (x 2 b) (x 3 c)) + (list a b)) + ((1 2 3) (a b c))) + +(test (when-match @(some (x @a @b)) '((y 1 a) (x 2 b) (z 3 c)) + (list a b)) + (2 b)) + +(test (if-match @(and (@x 2 3) (1 @y 3) (1 2 @z)) '(1 2 3) + (list x y z)) + (1 2 3)) + +(test (if-match @(or (@x 3 3) (1 @x 3) (1 2 @x)) '(1 2 3) x) 2) +(test (if-match @(op <= 10 @1 13) 11 :yes :no) :yes) +(test (when-match @(let x @(op <= 10 @1 13)) 11 x) 11) +(test (when-match (@(evenp) @(oddp x)) '(2 3) x) 3) |