diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-21 07:47:24 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-21 07:47:24 -0800 |
commit | 273ade88a34232d5270245f9ce6a97f4c6c73f7f (patch) | |
tree | a7f138ad4bb0ffdca7c2bb61593edc4e8cc2c20f | |
parent | d6ace4d01252ff29e7d125e17efd9b614d7023c5 (diff) | |
download | txr-273ade88a34232d5270245f9ce6a97f4c6c73f7f.tar.gz txr-273ade88a34232d5270245f9ce6a97f4c6c73f7f.tar.bz2 txr-273ade88a34232d5270245f9ce6a97f4c6c73f7f.zip |
matcher: more test cases.
* tests/011/patmatch.tl: Add test case matching with two
structures in circular relationship, and a loop around
match case for various cases involving backreference.
-rw-r--r-- | tests/011/patmatch.tl | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 42e9bd9a..493f4b2d 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -92,3 +92,32 @@ (test (when-match (@a @(let a @(some @a))) '(#1=(1 2 #1# 3) #1#) :yes) :yes) (test (when-match (@a @(let a @(or x @a))) '(#1=(1 2 #1# 3) #1#) :yes) :yes) + +(defstruct node () + left right) + +(mlet ((n (lnew node left (new node left n)))) + (test (when-match @(let x @(struct node + left @(struct node left @x))) + n :yes) + :yes)) + +(test + (collect-each ((obj (list '(1 2 3) + '(4 5) + '(3 5) + '(6 2 6) + #(11 12) + #S(time year 2021 month 1 day 2) + #S(time year 2020 month 1 day 1) + #(vec tor)))) + (match-case obj + (@(struct @s year 2021 day @d) (list d (struct-type-name s))) + (@(struct time year @y month @x day @x) (list y x)) + (#(@(integerp x) @(require @y (succ x))) (list x y)) + (#(@x @y) (list x y)) + ((@x @nil @x) x) + ((@nil @nil @x) x) + ((4 @x) x) + ((@x 5) x))) + (3 5 3 6 (11 12) (2 time) (2020 1) (vec tor))) |