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 | 1f137faba3243bb5836dc6fd0aafaf9cbf080470 (patch) | |
tree | a7f138ad4bb0ffdca7c2bb61593edc4e8cc2c20f | |
parent | 1ef988938b33903891819febe7e2b804598b369b (diff) | |
download | txr-1f137faba3243bb5836dc6fd0aafaf9cbf080470.tar.gz txr-1f137faba3243bb5836dc6fd0aafaf9cbf080470.tar.bz2 txr-1f137faba3243bb5836dc6fd0aafaf9cbf080470.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))) |