fix for massive code blowout when cominging or with lists

dcolthorp · Jan 18, 2011 · 386614e · 386614e
1 parent 4088444
commit 386614e
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 5 deletions.
diff --git a/src/matchure/compile.clj b/src/matchure/compile.clj
@@ -236,16 +236,18 @@ the following match functions are never evaluated. "
   (letfn [(compile-and [patterns matching-name state]
                        (if (empty? patterns)
                          (success state)
-                         (compile-pattern (first patterns) matching-name
-                                          (wrap-result state :success #(compile-and (rest patterns) matching-name %)))))]
+                         (compile-top-level-match [(first patterns) matching-name]
+                                                  (compile-and (rest patterns) matching-name state)
+                                                  (failure state))))]
     (compile-and patterns matching-name state)))
 
 (defmethod compile-list 'or [[_ & patterns] matching-name state]
   (letfn [(compile-or [patterns matching-name state]
                       (if (empty? patterns)
                         (failure state)
-                        (compile-pattern (first patterns) matching-name
-                                         (wrap-result state :failure #(compile-or (rest patterns) matching-name %)))))]
+                        (compile-top-level-match [(first patterns) matching-name]
+                                                 (success state)
+                                                 (compile-or (rest patterns) matching-name state))))]
     (compile-or patterns matching-name state)))
 
 (defmethod compile-list 'not [[_ pattern] matching-name state]

diff --git a/test/matchure_test.clj b/test/matchure_test.clj
@@ -117,7 +117,16 @@
       (is (not (if-match [(and ?a #"hello" #"world" (not #"goodbye")) "To world: hello. goodbye."] true)))
       (is (not (if-match [(and ?a #"hello" #"world" (not #"goodbye")) "Aw, hell, world"] true)))
       (is (not (if-match [(and ?a #"hello" #"world" (not #"goodbye")) "hello, give it a worl, d"] true)))))
-  )
+
+  (testing "regressions"
+    (is  (mexpand-all '(if-match [(or
+                                   [:black [:red [:red ?a ?x ?b] ?y ?c] ?z ?d]
+                                   [:black [:red ?a ?x [:red ?b ?y ?c]] ?z ?d]
+                                   [:black ?a ?x [:red [:red ?b ?y ?c] ?z ?d]] 
+                                   [:black ?a ?x [:red ?b ?y [:red ?c ?z ?d]]]
+                                   ) tree]
+                                 [:red [:black a x b] y [:black c z d]]
+                                 tree)))))
 
 
 (deftest test-when-match