CHICKEN bug? Definition of `%insert` in the test for `internal` was

interfering with the import definition for the srfi-113 test.

5 files changed, 44 insertions, 40 deletions

diff --git a/mcgoron/weight-balanced-trees/internal.scm b/mcgoron/weight-balanced-trees/internal.scm
index 73bc00c..3a9ae63 100644
--- a/mcgoron/weight-balanced-trees/internal.scm
+++ b/mcgoron/weight-balanced-trees/internal.scm
@@ -112,16 +112,20 @@
 ;;; Convert in-order vectors to ordered trees.
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(: in-order-vector->node (vector --> node-type))
-(define (in-order-vector->node vec)
+(: in-order-container->node ('a ('a fixnum -> *) fixnum --> node-type))
+(define (in-order-container->node container ref length)
   (define (divide left right)
     (if (< right left)
         '()
         (let ((midpoint (floor (/ (+ left right) 2))))
-          (wb-tree-node (vector-ref vec midpoint)
+          (wb-tree-node (ref container midpoint)
                         (divide left (- midpoint 1))
                         (divide (+ midpoint 1) right)))))
-  (divide 0 (- (vector-length vec) 1)))
+  (divide 0 (- length 1)))
+
+(: in-order-vector->node (vector --> node-type))
+(define (in-order-vector->node vec)
+  (in-order-container->node vec vector-ref (vector-length vec)))
 
 (: node->in-order-list (node-type --> list))
 (define (node->in-order-list node)
diff --git a/mcgoron/weight-balanced-trees/internal.sld b/mcgoron/weight-balanced-trees/internal.sld
index f9bf4ac..42ad1fc 100644
--- a/mcgoron/weight-balanced-trees/internal.sld
+++ b/mcgoron/weight-balanced-trees/internal.sld
@@ -31,7 +31,7 @@
           with-node
           get-data get-left get-right get-size
           balanced?
-          in-order-vector->node
+          in-order-vector->node in-order-container->node
           node->in-order-list
           join join2 split
           search
diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
index 7c31ece..5b456b1 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/sets.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -356,6 +356,10 @@
 (define (set->reverse-order-generator set)
   (node->reverse-order-generator (get-node set)))
 
+(define (in-order->set comparator container ref length)
+  (raw-set comparator
+           (in-order-container->node container ref length)))
+
 (define compatible-sets?
   (apply-nary-predicate
    (lambda (cmp s1 s2)
diff --git a/tests/internal.scm b/tests/internal.scm
index fc61f6e..e299fc9 100644
--- a/tests/internal.scm
+++ b/tests/internal.scm
@@ -397,15 +397,14 @@
 ;;; Update
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define %insert insert)
-(define (insert elem set)
-  (%insert number-comparator
-           set
-           elem))
+(define (%insert elem set)
+  (insert number-comparator
+          set
+          elem))
 
 (test-group "update of unordered list is balanced"
   (define (insert-unordered lst)
-    (let ((set (fold insert '() lst)))
+    (let ((set (fold %insert '() lst)))
       (balanced? set)))
   (test-property insert-unordered
                  (list (list-generator-of
@@ -413,7 +412,7 @@
 
 (test-group "update of unordered list is subset of list"
   (define (subset-of-list lst)
-    (let ((set (fold insert '() lst)))
+    (let ((set (fold %insert '() lst)))
       (when (verbose)
         (dynamic-property-set! 'lst lst)
         (dynamic-property-set! 'set (node->in-order-list set)))
@@ -425,7 +424,7 @@
 
 (test-group "list is subset of update of unordered list"
   (define (list-is-subset-of lst)
-    (let ((set (fold insert '() lst)))
+    (let ((set (fold %insert '() lst)))
       (node-every (cut memq <> lst) set)))
   (test-property list-is-subset-of
                  (list (list-generator-of
@@ -437,8 +436,8 @@
 
 (define (call/difference procedure)
   (lambda (lst1 lst2)
-    (let* ((set1 (fold insert '() lst1))
-           (set2 (fold insert '() lst2))
+    (let* ((set1 (fold %insert '() lst1))
+           (set2 (fold %insert '() lst2))
            (diff (difference number-comparator set1 set2))
            (deleted (fold (lambda (elem set)
                             (when (verbose)
@@ -451,7 +450,7 @@
 
 (test-group "delete of elements unordered list is balanced"
   (define (delete-balanced? lst1 lst2)
-    (let* ((set (fold insert '() lst1))
+    (let* ((set (fold %insert '() lst1))
            (deleted (fold (lambda (elem set)
                             (delete number-comparator set elem))
                           set
@@ -488,8 +487,8 @@
 
 (test-group "lset subset of xor"
   (define (lset-subset-of-xor lst1 lst2)
-    (let* ((node1 (fold insert '() lst1))
-           (node2 (fold insert '() lst2))
+    (let* ((node1 (fold %insert '() lst1))
+           (node2 (fold %insert '() lst2))
            (set-xor (xor number-comparator node1 node2))
            (list-xor (lset-xor = lst1 lst2)))
       (every (cut search number-comparator <> set-xor) list-xor)))
@@ -499,8 +498,8 @@
 
 (test-group "xor subset of lset"
   (define (xor-subset-of-lset lst1 lst2)
-    (let* ((node1 (fold insert '() lst1))
-           (node2 (fold insert '() lst2))
+    (let* ((node1 (fold %insert '() lst1))
+           (node2 (fold %insert '() lst2))
            (set-xor (xor number-comparator node1 node2))
            (list-xor (lset-xor = lst1 lst2)))
       (node-every (cut member <> list-xor) set-xor)))
@@ -514,7 +513,7 @@
 
 (test-group "node->generator"
   (define (node->generator-works lst)
-    (let* ((node (fold insert '() lst))
+    (let* ((node (fold %insert '() lst))
            (result-lst
             (generator->list (node->generator node))))
       (lset= = lst result-lst)))
@@ -532,7 +531,7 @@
 
 (test-group "node->in-order-generator"
   (define (node->in-order-generator-works lst)
-    (let* ((node (fold insert '() lst))
+    (let* ((node (fold %insert '() lst))
            (result-lst (generator->list
                         (node->in-order-generator node))))
       (and (lset= = lst result-lst)
@@ -542,7 +541,7 @@
 
 (test-group "node->reverse-order-generator"
   (define (node->reverse-order-generator-works lst)
-    (let* ((node (fold insert '() lst))
+    (let* ((node (fold %insert '() lst))
            (result-lst (generator->list
                         (node->reverse-order-generator node))))
       (and (lset= = lst result-lst)
diff --git a/tests/run.scm b/tests/run.scm
index 493dbf1..a4e504a 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -13,8 +13,7 @@
  | limitations under the License.
  |#
 
-(import r7rs
-        (srfi 64) (mcgoron srfi 64))
+(import r7rs (srfi 64) (mcgoron srfi 64))
 
 (load "random-number-vector.sld")
 (load "util.sld")
@@ -27,22 +26,20 @@
 (test-runner-current (test-runner-create))
 (set-verbosity! '(fails))
 
-#;(begin
-  (define-library (mcgoron weight-balanced-trees test internal)
-    (import (scheme base)
-            (chicken condition)
-            (mcgoron weight-balanced-trees test util)
-            (mcgoron weight-balanced-trees test random-number-vector)
-            (except (mcgoron srfi 64) factory)
-            (srfi 1) (srfi 26) (srfi 64) (srfi 128) (srfi 132) (srfi 133)
-            (srfi 158) (srfi 194) (srfi 197) (srfi 252)
-            (except (mcgoron weight-balanced-trees internal)
-                    every)
-            (prefix (only (mcgoron weight-balanced-trees internal)
+(define-library (mcgoron weight-balanced-trees test internal)
+  (import (scheme base)
+          (chicken condition)
+          (mcgoron weight-balanced-trees test util)
+          (mcgoron weight-balanced-trees test random-number-vector)
+          (except (mcgoron srfi 64) factory)
+          (srfi 1) (srfi 26) (srfi 64) (srfi 128) (srfi 132) (srfi 133)
+          (srfi 158) (srfi 194) (srfi 197) (srfi 252)
+          (except (mcgoron weight-balanced-trees internal)
+                  every)
+          (prefix (only (mcgoron weight-balanced-trees internal)
                           every)
-                    node-))
-    (include "internal.scm"))
-  (import (mcgoron weight-balanced-trees test internal)))
+                  node-))
+  (include "internal.scm"))
 
 (define-library (mcgoron weight-balanced-trees test srfi 113 sets)
   (import (scheme base)