Add tests based on examples. Move.

3 files changed, 87 insertions, 13 deletions

diff --git a/srfi-228-test.scm b/srfi-228-test.scm
new file mode 100644
index 0000000..85814bb
--- /dev/null
+++ b/srfi-228-test.scm
@@ -0,0 +1,83 @@
+(cond-expand
+  (chibi
+   (import (chibi test)
+	   (scheme base)
+           (srfi 1)
+	   (srfi 128)
+	   (only (srfi 132) list-sort))))
+
+(define-record-type Person
+    (make-person first-name last-name)
+    person?
+  (first-name person-first-name)
+  (last-name person-last-name))
+
+(define person-name-comparator
+  (make-product-comparator
+   (make-wrapper-comparator person? person-last-name string-ci-comparator)
+   (make-wrapper-comparator person? person-first-name string-ci-comparator)))
+
+(test-group "simple"
+  (test-equal eq?
+    #t
+    (<? person-name-comparator
+	(make-person "John" "Cowan")
+	(make-person "Daphne" "Preston-Kendal")))
+
+  (test-equal eq?
+    #t
+    (>? person-name-comparator
+	(make-person "Tom" "Smith")
+	(make-person "John" "Smith"))))
+
+(define-record-type Book
+    (make-book author title)
+    book?
+  (author book-author)
+  (title book-title))
+
+(define book-comparator
+  (make-product-comparator
+   (make-wrapper-comparator book? book-author person-name-comparator)
+   (make-wrapper-comparator book? book-title string-ci-comparator)))
+
+(define-record-type CD
+    (make-cd artist title)
+    cd?
+  (artist cd-artist)
+  (title cd-title))
+
+(define cd-comparator
+  (make-product-comparator
+   (make-wrapper-comparator cd? cd-artist person-name-comparator)
+   (make-wrapper-comparator cd? cd-title string-ci-comparator)))
+
+(define item-comparator
+  (make-sum-comparator book-comparator cd-comparator))
+
+(test-group "nested"
+  (let* ((beatles (make-person "The" "Beatles"))
+	 (abbey-road (make-cd beatles "Abbey Road"))
+	 (deutsche-grammatik
+	  (make-book (make-person "Jacob" "Grimm") "Deutsche Grammatik"))
+	 (sonnets (make-book (make-person "William" "Shakespeare") "Sonnets"))
+	 (mnd (make-book (make-person "William" "Shakespeare")
+			 "A Midsummer Night’s Dream"))
+	 (bob (make-cd (make-person "Bob" "Dylan") "Blonde on Blonde"))
+	 (revolver (make-cd (make-person "The" "Beatles") "Revolver")))
+  (test-equal
+      equal?
+    (list-sort
+     (lambda (a b) (<? item-comparator a b))
+     (list abbey-road
+	   deutsche-grammatik
+	   sonnets
+	   mnd
+	   bob
+	   revolver))
+    (list deutsche-grammatik
+	  mnd
+	  sonnets
+	  abbey-road
+	  revolver
+	  bob))))
\ No newline at end of file
diff --git a/srfi/228.sld b/srfi/228.sld
index f40776d..dfffd3e 100644
--- a/srfi/228.sld
+++ b/srfi/228.sld
@@ -1,6 +1,8 @@
 (define-library (srfi 228)
-  (import (srfi 1)
-          (srfi 128))
+  (import (scheme base)
+	  (srfi 1)
+          (srfi 128)
+	  (srfi 151))
   (export make-wrapper-comparator
           make-product-comparator
           make-sum-comparator
diff --git a/srfi/srfi-228-test.scm b/srfi/srfi-228-test.scm
deleted file mode 100644
index 305a4dc..0000000
--- a/srfi/srfi-228-test.scm
+++ /dev/null
@@ -1,11 +0,0 @@
-(import (chibi test))
-
-(define-record-type <date>
-  (make-date year month day)
-  date?
-  (year date-year)
-  (month date-month)
-  (day date-day))
-
-
-