diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-26 07:40:41 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-26 07:40:41 -0700 |
| commit | 80adc0257a941ccda132ca04a15ed98727fd8199 (patch) | |
| tree | e22841e130cd8defe48801c2676d28f5e45af619 | |
| parent | 6aa7f5abfb2e4c396b7f76ded0ef7dbded89c957 (diff) | |
| download | txr-80adc0257a941ccda132ca04a15ed98727fd8199.tar.gz txr-80adc0257a941ccda132ca04a15ed98727fd8199.tar.bz2 txr-80adc0257a941ccda132ca04a15ed98727fd8199.zip | |
matcher: quasi match incorrectly treats nil as bound.
* share/txr/stdlib/match.tl (expand-quasi-match): bound-p
local function must return nil if the symbol is nil.
* share/txr/stdlib/match.tl: New test cases testing that @nil
is treated as an unbound variable in the
non-consecutive-variables test. Also, making duplicates of
certain tests that start with a text match and sticking @nil
as the first element into them, so that the text match is
forced to be the second item.
| -rw-r--r-- | share/txr/stdlib/match.tl | 2 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 6 |
2 files changed, 6 insertions, 2 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index d3d89702..0e48773f 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -836,7 +836,7 @@ (labels ((bound-p (vlist vars sym) (cond ((bindable sym) (or (member sym vars) vlist.(exists sym))) - ((null sym) t) + ((null sym) nil) ((compile-error *match-form* "bindable symbol expected, not ~s" sym)))) (normalize (args) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 063e574b..54dda990 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -344,7 +344,11 @@ (test (when-match `@a` "abc" a) "abc") (macro-time-let ((*stderr* *stdnull*)) - (test (when-match `@a@b` "abc" a) :error)) + (test (when-match `@a@b` "abc" a) :error) + (test (when-match `@nil@b` "abc" a) :error) + (test (when-match `@nil@nil` "abc" a) :error) + (test (when-match `@a@nil` "abc" a) :error)) + (test (when-match `@a-$` "a-$" a) "a") (test (when-match `#@a-$` "#a-$" a) "a") |