diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-26 07:20:49 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-26 07:20:49 -0700 |
commit | 538323f3a21632f1b8a6443ed79e2305306cee7b (patch) | |
tree | 5dec289d6d8ea0799a3a9ecabc2839c9c6b74061 | |
parent | 59a96304bd8716eb68c672ab6970111565e3f269 (diff) | |
download | txr-538323f3a21632f1b8a6443ed79e2305306cee7b.tar.gz txr-538323f3a21632f1b8a6443ed79e2305306cee7b.tar.bz2 txr-538323f3a21632f1b8a6443ed79e2305306cee7b.zip |
matcher: bugfix in `text{rest}` case.
* share/txr/stdlib/match.tl (expand-quasi-match): Calculate
npos correctly relative to current pos. Use match-str rather
than starts-with.
-rw-r--r-- | share/txr/stdlib/match.tl | 4 | ||||
-rw-r--r-- | tests/011/patmatch.tl | 3 |
2 files changed, 5 insertions, 2 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index f429a9c9..5586b874 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -852,8 +852,8 @@ ;; `txt@...` ((@(stringp @txt) . @rest) (with-gensyms (npos) - (cons ^@(require @(with ,npos ,(len txt)) - (starts-with ,txt ,str)) + (cons ^@(require @(with ,npos (+ ,pos (len ,txt))) + (match-str ,str ,txt ,pos)) (quasi-match vlist rest vars str npos)))) ;; `@var` (existing binding) (((@(eq 'sys:var) @(bound-p vlist vars @sym) . @nil)) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 38df4c62..063e574b 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -376,6 +376,9 @@ (test (when-match `@x@x` "123123" t) t) (test (when-match `@x@{x [1..:]}` "12323" t) t)) +(let ((a "$")) + (test (when-match `@a-@b` "$-@" b) "@")) + (compile-only (eval-only (compile-file (base-name *load-path*) "temp.tlo") |