From 399d0b64bedd8c8456857f4d308aa95425e3f9ed Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 4 Feb 2022 19:39:39 -0800 Subject: matcher: bug: quasiliteral allowing prefix matches. * stdlib/match.tl (expand-quasi-match): When matching `text` or `@var`, which are matching in the final position of the specimen, it is not good enough that match-str returns true; we must check that the entire string was matched. Reported by Paul A. Patience. --- stdlib/match.tl | 7 ++++--- tests/011/patmatch.tl | 5 ++++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/stdlib/match.tl b/stdlib/match.tl index 47593fb3..cdc1415c 100644 --- a/stdlib/match.tl +++ b/stdlib/match.tl @@ -920,7 +920,7 @@ (match-case args ;; `text` ((@(stringp @txt)) - (list ^@(require @nil (match-str ,str ,txt ,pos)))) + (list ^@(require @nil (eql (len ,str) (match-str ,str ,txt ,pos))))) ;; `txt@...` ((@(stringp @txt) . @rest) (with-gensyms (npos) @@ -940,8 +940,9 @@ (quasi-match vlist rest vars str npos)))) ;; `@var` (existing binding) (((@(eq 'sys:var) @(bound-p vlist vars @sym) . @nil)) - (list ^@(require @nil (match-str ,str (sys:quasi ,(car args)) - ,pos)))) + (list ^@(require @nil (eql (len ,str) + (match-str ,str (sys:quasi ,(car args)) + ,pos))))) ;; `@var@...` (existing binding) ((@(as avar (@(eq 'sys:var) @(bound-p vlist vars @sym) . @nil)) . @rest) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 4b44eca9..c9eb3d39 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -355,7 +355,10 @@ (mtest (when-match `` "" t) t (when-match `abc` "abc" t) t - (when-match `@a` "abc" a) "abc") + (when-match `abc` "abcdef" t) nil + (when-match `@a` "abc" a) "abc" + (let ((x "foo")) (when-match `@x` "foobar" t)) nil + (let ((x "foo")) (when-match `@x` "foo" x)) "foo") (mtest (when-match `@a@b` "abc" a) :error -- cgit v1.2.3