From f9a2fdbcdfa8fb801e23c72d4931b99cf4fa8a71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Thu, 6 Jul 2023 21:50:21 +0200
Subject: [PATCH] Add basic BST tests.

---
 src/util-bst.scm | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/src/util-bst.scm b/src/util-bst.scm
index 9649dd9..25559db 100644
--- a/src/util-bst.scm
+++ b/src/util-bst.scm
@@ -22,6 +22,8 @@
   ;;kvv-filter
   
   ;;bst-balance
+
+  util-bst-tests!
   )
 
  (import scheme
@@ -29,8 +31,8 @@
 	 testing)
 
  ;; Unique tags
- (define TAG-BST (make-tag 'bst))
- (define TAG-KVV (make-tag 'kvv))
+ (define TAG-BST (make-tag bst))
+ (define TAG-KVV (make-tag kvv))
 
  (define/doc (make-bst subtag EQ? <?)
    ("Creates empty BST with given comparators")
@@ -60,10 +62,35 @@
    ("Returns #t if given BST is empty.")
    (not (bst-root bst)))
 
+ ;; Wrapper to setup comparators
+ (define-syntax define-bst-proc
+   (syntax-rules ()
+     ((_ EQ? <? (name bst . args) expr ...)
+      (define (name bst . args)
+	(let ((EQ? (bst-eq? bst))
+	      (<? (bst-<? bst)))
+	  expr ...)))))
+
  ;; Module self-tests
  (define (util-bst-tests!)
    (run-tests
     util-bst
+    (test-equal? make-bst
+		 (make-bst 'fixnum eq? <)
+		 `(,TAG-BST
+		   . ((#f . 0)
+		      . (fixnum . (,eq? . ,<)))))
+    (test-true bst?
+	       ((bst? 'fixnum) (make-bst 'fixnum eq? <)))
+    (test-false bst?
+		((bst? 'fixnum) (make-bst 'string eq? <)))
+    (test-false bst?
+		((bst? 'fixnum) "string"))
+    (test-true bst-empty?
+	       (bst-empty? (make-bst 'fixnum eq? <)))
     ))
 
  )
+
+(import util-bst)
+(util-bst-tests!)