add makefile for testing; test with more implementations; move library to .sld; fix srfi-125 pop!

5 files changed, 115 insertions, 86 deletions

diff --git a/dictionaries-test.scm b/dictionaries-test.scm
index 58252a0..30b5708 100644
--- a/dictionaries-test.scm
+++ b/dictionaries-test.scm
@@ -1,9 +1,13 @@
 (import (scheme base)
-        (scheme case-lambda)
-        (srfi 1))
+        (scheme case-lambda))
+
+(cond-expand
+  (guile (import (srfi srfi-1)))
+  (else (import (srfi 1))))
 
 (cond-expand
   (kawa (import (srfi 69 basic-hash-tables)))
+  (guile (import (srfi srfi-69)))
   ((library (srfi 125))
    (import (srfi 125)))
   ((library (srfi 69))
@@ -11,23 +15,19 @@
   (else))
 
 (cond-expand
+  (guile)
   ((library (srfi 126))
    (import (srfi 126)))
   (else))
 
 (cond-expand
-  ((library (srfi 64)) 
-   (import (srfi 64)))
-  (chibi 
-    (import (except (chibi test) test-equal)))
-  (else (error "No testing framework")))
-
-(cond-expand
+  (guile
+   (import (srfi srfi-64)))
   (chibi
-    (define-syntax test-equal
-        (syntax-rules ()
-          ((_ args ...) (test args ...)))))
-  (else))
+   (import (rename (except (chibi test) test-equal)
+                   (test test-equal))))
+  (else
+   (import (srfi 64))))
 
 ; use include instead of import
 ; so that registering is done in isolated way
@@ -205,7 +205,7 @@
               (lambda (insert ignore)
                 (ignore 'foo))
               (lambda args
-                (error))))
+                (error "shouldn't happen"))))
      (test-equal '((a . b)) (dict->alist dict))
      (test-equal value 'foo))
 
@@ -217,7 +217,7 @@
               (lambda (insert ignore)
                 (insert 'd 'foo))
               (lambda args
-                (error))))
+                (error "shouldn't happen"))))
      (test-equal 'b (dict-ref dict 'a))
      (test-equal 'd (dict-ref dict 'c))
      (test-equal value 'foo))
@@ -228,7 +228,7 @@
        (dict value)
        (dict-search! (alist->dict '((a . b))) 'a
               (lambda args
-                (error))
+                (error "shouldn't happen"))
               (lambda (key value update delete)
                 (update 'a2 'b2 'foo))))
      (test-equal '((a2 . b2)) (dict->alist dict))
@@ -240,7 +240,7 @@
        (dict value)
        (dict-search! (alist->dict '((a . b) (c . d))) 'a
               (lambda args
-                (error))
+                (error "shouldn't happen"))
               (lambda (key value update delete)
                 (delete 'foo))))
      (test-equal '((c . d)) (dict->alist dict))
@@ -400,7 +400,8 @@
                   alist)))))
 
 (cond-expand
-  ((or (library (srfi 69))
+  ((or guile
+       (library (srfi 69))
        (library (srfi 125)))
    (test-group
      "srfi-69"
@@ -413,9 +414,11 @@
                   (lambda (pair)
                     (hash-table-set! table (car pair) (cdr pair)))
                   alist)
-                table)))))
+                table))))
+  (else))
 
 (cond-expand
+  (guile)
   ((library (srfi 125))
    (test-group
      "srfi-125"
@@ -428,9 +431,11 @@
                   (lambda (pair)
                     (hash-table-set! table (car pair) (cdr pair)))
                   alist)
-                table)))))
+                table))))
+  (else))
 
 (cond-expand
+  (guile)
   ((library (srfi 126))
    (test-group
      "srfi-126 (r6rs)"
@@ -443,6 +448,7 @@
                   (lambda (pair)
                     (hashtable-set! table (car pair) (cdr pair)))
                   alist)
-                table)))))
+                table))))
+  (else))
 
 (test-end)
diff --git a/dictionaries.scm b/dictionaries.scm
deleted file mode 100644
index e90d1f9..0000000
--- a/dictionaries.scm
+++ /dev/null
@@ -1,62 +0,0 @@
-(define-library
-  (dictionaries)
-  (import (scheme base)
-          (scheme case-lambda)
-          (srfi 1))
-  
-  (cond-expand
-    (kawa (import (srfi 69 basic-hash-tables)))
-    ((library (srfi 69)) (import (srfi 69))) 
-    (else))
-  
-  (cond-expand
-    ((library (srfi 125)) (import (srfi 125))) 
-    (else))
-  
-  (cond-expand
-    ((library (srfi 126)) (import (srfi 126)))
-    (else))
-  
-  (export 
-    
-    ;; predicates
-    dictionary?
-    dict-empty?
-    dict-contains?
-    
-    ;; lookup
-    dict-ref
-    dict-ref/default
-    
-    ;; mutation
-    dict-set!
-    dict-adjoin!
-    dict-delete!
-    dict-delete-all!
-    dict-replace!
-    dict-intern!
-    dict-update!
-    dict-update/default!
-    dict-pop!
-    dict-map!
-    dict-filter!
-    dict-remove!
-    dict-search!
-    
-    ;; whole dictionary
-    dict-size
-    dict-for-each
-    dict-count
-    dict-any
-    dict-every
-    dict-keys
-    dict-values
-    dict-entries
-    dict-fold
-    dict-map->list
-    dict->alist
-    
-    ;; registering dictionary types
-    register-dictionary!)
-  
-  (include "dictionaries-impl.scm"))
diff --git a/dictionaries.sld b/dictionaries.sld
index 3dfc689..e6c9b8d 120000..100644
--- a/dictionaries.sld
+++ b/dictionaries.sld
@@ -1 +1,65 @@
-dictionaries.scm
\ No newline at end of file
+(define-library
+  (dictionaries)
+  (import (scheme base)
+          (scheme case-lambda)
+          (srfi 1))
+
+  (cond-expand
+    (kawa (import (srfi 69 basic-hash-tables)))
+    (guile (import (srfi srfi-69)))
+    ((library (srfi 69)) (import (srfi 69)))
+    (else))
+
+  (cond-expand
+    (guile)
+    ((library (srfi 125)) (import (srfi 125)))
+    (else))
+
+  (cond-expand
+    (guile)
+    ((library (srfi 126)) (import (srfi 126)))
+    (else))
+
+  (export
+
+    ;; predicates
+    dictionary?
+    dict-empty?
+    dict-contains?
+
+    ;; lookup
+    dict-ref
+    dict-ref/default
+
+    ;; mutation
+    dict-set!
+    dict-adjoin!
+    dict-delete!
+    dict-delete-all!
+    dict-replace!
+    dict-intern!
+    dict-update!
+    dict-update/default!
+    dict-pop!
+    dict-map!
+    dict-filter!
+    dict-remove!
+    dict-search!
+
+    ;; whole dictionary
+    dict-size
+    dict-for-each
+    dict-count
+    dict-any
+    dict-every
+    dict-keys
+    dict-values
+    dict-entries
+    dict-fold
+    dict-map->list
+    dict->alist
+
+    ;; registering dictionary types
+    register-dictionary!)
+
+  (include "dictionaries-impl.scm"))
diff --git a/makefile b/makefile
new file mode 100644
index 0000000..fc060e5
--- /dev/null
+++ b/makefile
@@ -0,0 +1,21 @@
+.PHONY: test-guile test-gauche test-kawa test-chibi test-chicken
+
+test-guile:
+	guile -L . --r7rs dictionaries-test.scm
+
+test-gauche:
+	gosh -I . dictionaries-test.scm
+
+test-kawa:
+	cp dictionaries.sld dictionaries.scm
+	kawa dictionaries-test.scm
+	rm dictionaries.scm
+
+test-chibi:
+	chibi-scheme dictionaries-test.scm
+
+test-chicken:
+	csc -R r7rs -X r7rs -sJ -o dictionaries.so dictionaries.sld
+	csi -I . -R r7rs -s dictionaries-test.scm
+	rm dictionaries.so
+	rm dictionaries.import.scm
diff --git a/srfi-125-impl.scm b/srfi-125-impl.scm
index b683a2a..0527547 100644
--- a/srfi-125-impl.scm
+++ b/srfi-125-impl.scm
@@ -16,9 +16,9 @@
     (define val (hash-table-intern! table key failure))
     (values table val))
   
-  (define (hash-table-pop!* table fail)
+  (define (hash-table-pop!* table)
     (if (hash-table-empty? table)
-        (fail)
+        (error "popped empty dictionary")
         (call-with-values
           (lambda () (hash-table-pop! table))
           (lambda (key value) (values table key value)))))