From 2a0ec7b4e5cc388ab8963d961db9311331e8a5a5 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 25 Apr 2021 02:33:30 -0700
Subject: matcher: second round of quasi tests and fixes.

* share/txr/stdlib/match.tl (expan-quasi-match): Use rest
variable consistently instead of (cdr args). Two instances of
(cdr rest) should just be rest. New case added for variable
with no modifiers followed by text being the last item.
---
 share/txr/stdlib/match.tl | 14 +++++++++-----
 tests/011/patmatch.tl     |  6 ++++++
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 0c10dfb1..80750e6c 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -867,7 +867,7 @@
                          ^@(with ,npos (+ ,pos ,len))
                          ^@(require @nil
                              (str= ,txt (sub-str ,str ,pos ,npos)))
-                         (quasi-match vlist (cdr args) vars str npos))))
+                         (quasi-match vlist rest vars str npos))))
                ;; `@var` (new binding)
                (((@(eq 'sys:var) @sym))
                 (list ^@(with ,sym (sub-str ,str ,pos t))))
@@ -905,14 +905,19 @@
                          ^@(with ,sym (sub-str ,str ,pos ,npos))
                          (quasi-match vlist rest (cons sym vars) str npos))))
                ;; `@{var}txt` (new binding)
+               (((@(eq 'sys:var) @sym) @(stringp @txt))
+                (with-gensyms (len end)
+                  (list ^@(require @(with ,end (search-str ,str ,txt ,pos))
+                           ,end (eql (+ ,end ,(len txt)) (len ,str)))
+                        ^@(with ,sym (sub-str ,str ,pos ,end)))))
+               ;; `@{var}txt...` (new binding)
                (((@(eq 'sys:var) @sym) @(stringp @txt) . @rest)
                 (with-gensyms (len end npos)
                   (list* ^@(require @(with ,end (search-str ,str ,txt ,pos))
                             ,end)
                          ^@(with ,npos (+ ,end ,(len txt)))
                          ^@(with ,sym (sub-str ,str ,pos ,end))
-                         (quasi-match vlist (cdr rest) (cons sym vars)
-                                      str npos))))
+                         (quasi-match vlist rest (cons sym vars) str npos))))
                ;; `@var0@var1` (unbound followed by bound)
                (((@(eq 'sys:var) @sym)
                  (@(eq 'sys:var) @(bound-p vlist vars @bsym) . @mods)
@@ -923,8 +928,7 @@
                             ,end)
                          ^@(with ,npos (+ ,end (len ,txt)))
                          ^@(with ,sym (sub-str ,str ,pos ,end))
-                         (quasi-match vlist (cdr rest) (cons sym vars)
-                                      str npos))))
+                         (quasi-match vlist rest (cons sym vars) str npos))))
                ;; `@{var whatever}@...`(new binding, unsupported modifiers)
                (((@(eq 'sys:var) @sym @mods . @nil) . @rest)
                 (compile-error *match-form*
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index ad9015db..c40d5ea5 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -348,6 +348,12 @@
 
 (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 #/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"))
 
 (compile-only
   (eval-only
-- 
cgit v1.2.3