insert and delete

1 files changed, 86 insertions, 7 deletions

diff --git a/tests/run.scm b/tests/run.scm
index f9218bc..365fa29 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -11,6 +11,11 @@
  | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  | See the License for the specific language governing permissions and
  | limitations under the License.
+ |----------------------------------------------
+ | This test suite would be better if property tests (and by association
+ | generators) could take multiple values. As it stands now property
+ | test generators cannot be correlated without doing a hack like returning
+ | a vector (which the current implementation does).
  |#
 
 (import r7rs)
@@ -18,17 +23,17 @@
 (load "random-number-vector.sld")
 (load "util.sld")
 
-(import (except (mcgoron weight-balanced-trees internal)
-                every)
-        (prefix (only (mcgoron weight-balanced-trees internal)
-                      every)
-                node-)
-        (mcgoron weight-balanced-trees test util)
+(import (mcgoron weight-balanced-trees test util)
         (mcgoron weight-balanced-trees test random-number-vector)
         (prefix (only (mcgoron srfi 64) factory) mcgoron-test-)
         (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))
+        (srfi 158) (srfi 194) (srfi 197) (srfi 252)
+        (except (mcgoron weight-balanced-trees internal)
+                every)
+        (prefix (only (mcgoron weight-balanced-trees internal)
+                      every)
+                node-))
 
 ;;; ;;;;;;;;;;;;;;;;
 ;;; Parameters
@@ -412,3 +417,77 @@
                  (list (vector->node-generator)
                        (vector->node-generator))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Update
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (insert elem set)
+  (update number-comparator
+          set
+          elem
+          (lambda (value) value)
+          (lambda ()
+            (wb-tree-node elem '() '()))))
+
+(test-group "update of unordered list is balanced"
+  (define (insert-unordered lst)
+    (let ((set (fold insert '() lst)))
+      (balanced? set)))
+
+  (test-property insert-unordered
+                 (list (list-generator-of
+                        (exact-integer-generator)))))
+
+(test-group "update of unordered list is subset of list"
+  (define (subset-of-list lst)
+    (let ((set (fold insert '() lst)))
+      (when (verbose)
+        (dynamic-property-set! 'lst lst)
+        (dynamic-property-set! 'set (node->in-order-list set)))
+      (every (cut search number-comparator <> set) lst)))
+  (parameterize ((verbose #f))
+    (test-property subset-of-list
+                   (list (list-generator-of
+                          (exact-integer-generator))))))
+
+(test-group "list is subset of update of unordered list"
+  (define (list-is-subset-of lst)
+    (let ((set (fold insert '() lst)))
+      (node-every (cut memq <> lst) set)))
+  (test-property list-is-subset-of
+                 (list (list-generator-of
+                        (exact-integer-generator)))))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Delete
+;;; ;;;;;;;;;;;;;;;;
+
+(define (call/difference procedure)
+  (lambda (lst1 lst2)
+    (let* ((set1 (fold insert '() lst1))
+           (set2 (fold insert '() lst2))
+           (diff (difference number-comparator set1 set2))
+           (deleted (fold (lambda (elem set)
+                            (when (verbose)
+                              (dynamic-property-set! 'elem elem)
+                              (dynamic-property-set! 'set set))
+                            (delete number-comparator elem set))
+                          set1
+                          lst2)))
+      (procedure lst1 lst2 diff deleted))))
+
+(test-group "delete of two sets is subset of difference"
+  (define (delete-and-difference lst1 lst2 diff deleted)
+    (node-every (cut search number-comparator <> diff) deleted))
+  (parameterize ((verbose #f))
+    (test-property (call/difference delete-and-difference)
+                   (list (list-generator-of (exact-integer-generator))
+                         (list-generator-of (exact-integer-generator))))))
+
+(test-group "difference is subset of delete of two sets"
+  (define (difference-and-delete lst1 lst2 diff deleted)
+    (node-every (cut search number-comparator <> deleted) diff))
+  (test-property (call/difference difference-and-delete)
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+