Update (ice-9 match) to include selected bug fixes from upstream.

Fixes <https://bugs.gnu.org/22925> and other bugs.

* module/ice-9/match.upstream.scm: Apply selected fixes from the
upstream match.scm in Chibi-Scheme.
* test-suite/tests/match.test.upstream: Add more tests from upstream.

diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm
index 350c01ec35db2eb863711bf8837a30e084f84a5b..1983c1e3f0950e18acf262a1df6197de0ab8089c 100644 (file)
--- a/module/ice-9/match.upstream.scm
+++ b/module/ice-9/match.upstream.scm
@@ -210,6 +210,11 @@
 ;; performance can be found at
 ;;   http://synthcode.com/scheme/match-cond-expand.scm
 ;;
+;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe)
+;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns
+;; 2014/11/24 - [OMITTED IN GUILE] adding Gauche's `@' pattern for named record field matching
+;; 2012/12/26 - wrapping match-let&co body in lexical closure
+;; 2012/11/28 - fixing typo s/vetor/vector in largely unused set! code
 ;; 2012/05/23 - fixing combinatorial explosion of code in certain or patterns
 ;; 2011/09/25 - fixing bug when directly matching an identifier repeated in
 ;;              the pattern (thanks to Stefan Israelsson Tampe)
@@ -675,7 +680,7 @@
        (if (>= j len)
          (let ((id (reverse id-ls)) ...) (sk ... i))
          (let ((w (vector-ref v j)))
-           (match-one w p ((vector-ref v j) (vetor-set! v j))
+           (match-one w p ((vector-ref v j) (vector-set! v j))
                       (match-drop-ids (loop (+ j 1) (cons id id-ls) ...))
                       fk i)))))))
 
@@ -765,13 +770,13 @@
      (match-extract-vars x k i v))
     ((match-extract-quasiquote-vars (unquote x) k i v (#t . d))
      (match-extract-quasiquote-vars x k i v d))
-    ((match-extract-quasiquote-vars (x . y) k i v (#t . d))
+    ((match-extract-quasiquote-vars (x . y) k i v d)
      (match-extract-quasiquote-vars
       x
-      (match-extract-quasiquote-vars-step y k i v d) i ()))
-    ((match-extract-quasiquote-vars #(x ...) k i v (#t . d))
+      (match-extract-quasiquote-vars-step y k i v d) i () d))
+    ((match-extract-quasiquote-vars #(x ...) k i v d)
      (match-extract-quasiquote-vars (x ...) k i v d))
-    ((match-extract-quasiquote-vars x (k ...) i v (#t . d))
+    ((match-extract-quasiquote-vars x (k ...) i v d)
      (k ... v))
     ))
 
@@ -812,7 +817,7 @@
     ((_ ((var value) ...) . body)
      (match-let/helper let () () ((var value) ...) . body))
     ((_ loop ((var init) ...) . body)
-     (match-named-let loop ((var init) ...) . body))))
+     (match-named-let loop () ((var init) ...) . body))))
 
 ;;> Similar to @scheme{match-let}, but analogously to @scheme{letrec}
 ;;> matches and binds the variables with all match variables in scope.
@@ -857,7 +862,7 @@
 (define-syntax match-let*
   (syntax-rules ()
     ((_ () . body)
-     (begin . body))
+     (let () . body))
     ((_ ((pat expr) . rest) . body)
      (match expr (pat (match-let* rest . body))))))
 

diff --git a/test-suite/tests/match.test.upstream b/test-suite/tests/match.test.upstream
index e1e106e3bb3a00893383bbec4e6f4ef06a8c0e15..7cbb80433cd1e565b27e06a053a352cbacdd0b4c 100644 (file)
--- a/test-suite/tests/match.test.upstream
+++ b/test-suite/tests/match.test.upstream
@@ -28,6 +28,7 @@
 (test "duplicate symbols fail" 'ok (match '(ok . bad) ((x . x) 'bad) (else 'ok)))
 (test "duplicate symbols samth" 'ok (match '(ok . ok) ((x . 'bad) x) (('ok . x) x)))
 (test "duplicate symbols bound" 3 (let ((a '(1 2))) (match a ((and (a 2) (1 b)) (+ a b)) (_ #f))))
+(test "duplicate quasiquote" 'ok (match '(a b) ((or `(a ,x) `(,x b)) 'ok) (_ #f)))
 
 (test "ellipses" '((a b c) (1 2 3))
   (match '((a . 1) (b . 2) (c . 3))
@@ -166,4 +167,12 @@
       (((and x (? symbol?)) ..1) x)
       (else #f)))
 
+(test "match-named-let" 6
+    (match-let loop (((x . rest) '(1 2 3))
+                     (sum 0))
+      (let ((sum (+ x sum)))
+        (if (null? rest)
+            sum
+            (loop rest sum)))))
+
 (test-end)