Use assoc symbols for keys instead of strings for objects.

Update the test suite to be more compatible with SRFI 64.

9 files changed, 73 insertions, 92 deletions

diff --git a/.gitignore b/.gitignore
index 14fea66..9865986 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
 **/*~
 README.html
-*.tgz
\ No newline at end of file
+*.tgz
+*.log
\ No newline at end of file
diff --git a/lib/zambyte/meta/180.scm b/lib/zambyte/meta/180.scm
index 1010614..30c0c74 100644
--- a/lib/zambyte/meta/180.scm
+++ b/lib/zambyte/meta/180.scm
@@ -1,12 +1,7 @@
 (import (except (srfi 180) json-null)
 	(srfi 1))
 (begin
-  (define (json-object . pairs)
-    (map
-     (lambda (pair)
-       (cons (string->symbol (car pair)) (cdr pair)))
-     pairs))
-
+  (define json-object list)
   (define json-list vector)
   (define json-null 'null)
   (define json-object? list?)
@@ -14,7 +9,7 @@
   ;; json-null? already defined in srfi 180
 
   (define (json-object-contains-key? obj key)
-    (and (assoc (string->symbol key) obj) #t))
+    (and (assoc key obj) #t))
 
   (define (string->json str)
     (call-with-port (open-input-string str)
@@ -28,18 +23,12 @@
 	(get-output-string port))))
 
   (define (json-object-ref json key)
-    (let ((pair (assoc (string->symbol key) json)))
+    (let ((pair (assoc key json)))
       (if pair
 	  (cdr pair)
 	  ((json-key-not-found)))))
 
   (define json-list-ref vector-ref)
   (define json-list-length vector-length)
-
-  (define (json-object->alist json)
-    (map
-     (lambda (pair)
-       (cons (symbol->string (car pair)) (cdr pair)))
-     json))
-
-  (define (json-list->list vector->list)))
+  (define json-object->alist values)
+  (define json-list->list vector->list))
diff --git a/lib/zambyte/meta/chibi.scm b/lib/zambyte/meta/chibi.scm
index d7a7783..812694f 100644
--- a/lib/zambyte/meta/chibi.scm
+++ b/lib/zambyte/meta/chibi.scm
@@ -1,19 +1,14 @@
 (import (chibi json)
 	(srfi 1))
 (begin
-  (define (json-object . pairs)
-    (map
-     (lambda (pair)
-       (cons (string->symbol (car pair)) (cdr pair)))
-     pairs))
-
+  (define json-object list)
   (define json-list vector)
   (define json-null (if #f #f))
   (define json-object? list?)
   (define json-list? vector?)
 
   (define (json-object-contains-key? obj key)
-    (and (assoc (string->symbol key) obj) #t))
+    (and (assoc key obj) #t))
 
   (define (json-null? obj)
     (eq? obj json-null))
@@ -22,18 +17,12 @@
   ;; string->json already defined in chibi json
 
   (define (json-object-ref json key)
-    (let ((pair (assoc (string->symbol key) json)))
+    (let ((pair (assoc key json)))
       (if pair
 	  (cdr pair)
 	  ((json-key-not-found)))))
 
   (define json-list-ref vector-ref)
   (define json-list-length vector-length)
-
-  (define (json-object->alist json)
-    (map
-     (lambda (pair)
-       (cons (symbol->string (car pair)) (cdr pair)))
-     json))
-
+  (define json-object->alist values)
   (define json-list->list vector->list))
diff --git a/lib/zambyte/meta/gauche.scm b/lib/zambyte/meta/gauche.scm
index 6f233bf..88093e5 100644
--- a/lib/zambyte/meta/gauche.scm
+++ b/lib/zambyte/meta/gauche.scm
@@ -2,7 +2,11 @@
 	(rfc json)
 	(srfi 1))
 (begin
-  (define json-object list)
+  (define (json-object . pairs)
+    (map (lambda (pair)
+	   (cons (symbol->string (car pair))
+		 (cdr pair)))
+	 pairs))
   (define json-list vector)
   (define json-null 'null)
   (define json-object? list?)
@@ -12,7 +16,7 @@
     (eq? obj json-null))
 
   (define (json-object-contains-key? obj key)
-    (and (assoc key obj) #t))
+    (and (assoc (symbol->string key) obj) #t))
 
   (define array-handler list->vector)
   (define object-handler identity)
@@ -38,5 +42,11 @@
 
   (define json-list-ref vector-ref)
   (define json-list-length vector-length)
-  (define json-object->alist identity)
+
+  (define (json-object->alist obj)
+    (map (lambda (pair)
+	   (cons (string->symbol (car pair))
+		 (cdr pair)))
+	 obj))
+
   (define json-list->list vector->list))
diff --git a/run-tests.sh b/run-tests.sh
index 556c8b6..8178ad5 100755
--- a/run-tests.sh
+++ b/run-tests.sh
@@ -1,15 +1,8 @@
 #!/bin/sh
 
-echo ";;;; Start Chibi"
+echo
 chibi-scheme -I ./lib ./test/chibi.scm
-echo ";;;; End Chibi"
-echo ";;;; Start Gauche"
+echo
 gosh -r7 -I ./lib ./test/gauche.scm
-echo ";;;; End Gauche"
-echo ";;;; Start Gerbil"
+echo
 GERBIL_LOADPATH="./lib" gxi --lang r7rs ./test/gerbil.scm
-echo ";;;; End Gerbil"
-echo ";;;; Start Guile"
-guile --r7rs -L ./lib
-echo ";;;; End Guile"
-
diff --git a/test/chibi.scm b/test/chibi.scm
index 2bd9da5..7d960f2 100644
--- a/test/chibi.scm
+++ b/test/chibi.scm
@@ -1,7 +1,12 @@
 (import (scheme base)
-	(scheme load)
-	(chibi test))
+	(except (chibi test) test-equal))
 
 (import (zambyte meta json))
 
-(load "./test/run.scm")
+;-(
+(define (test-equal name expected actual)
+  (test-assert name (test-equal? expected actual)))
+
+(test-begin "chibi")
+(include "./test/run.scm")
+(test-end "chibi")
diff --git a/test/gauche.scm b/test/gauche.scm
index 1388b1e..929ea6a 100644
--- a/test/gauche.scm
+++ b/test/gauche.scm
@@ -1,21 +1,8 @@
 (import (scheme base)
-	(prefix (gauche test) g:))
+	(srfi 64))
 
 (import (zambyte meta json))
 
-(define-syntax test
-  (syntax-rules ()
-    ((_ name expected actual)
-     (g:test name expected (lambda () actual) equal?))))
-
-(define-syntax test-assert
-  (syntax-rules ()
-    ((_ name expr)
-     (g:test name #t (lambda () expr) eq?))))
-
-(define-syntax test-not
-  (syntax-rules ()
-    ((_ name expr)
-     (g:test name #f (lambda () expr) eq?))))
-
+(test-begin "gauche")
 (include "run.scm")
+(test-end "gauche")
diff --git a/test/gerbil.scm b/test/gerbil.scm
index ca730d0..bfd0ddb 100644
--- a/test/gerbil.scm
+++ b/test/gerbil.scm
@@ -3,19 +3,20 @@
 
 (import (zambyte meta json))
 
-(define-syntax test
+(define-syntax test-equal
   (syntax-rules ()
     ((_ name expected actual)
-     (test-case name (check-output actual expected)))))
+     (test-case name (check-equal? actual expected)))))
 
 (define-syntax test-assert
   (syntax-rules ()
     ((_ name actual)
      (test-case name (check-predicate actual values)))))
 
-(define-syntax test-not
-  (syntax-rules ()
-    ((_ name actual)
-     (test-case name (check-predicate actual not)))))
+(define suite
+  (test-suite
+   "gerbil"
+   (include "run.scm")))
+
+(run-test-suite! suite)
 
-(include "run.scm")
diff --git a/test/run.scm b/test/run.scm
index 58f1085..6d8f9f0 100644
--- a/test/run.scm
+++ b/test/run.scm
@@ -2,14 +2,14 @@
   (json-object? (json-object)))
 
 (test-assert "json-object should meet json-object?"
-  (json-object? (json-object '("name" . "alice")
-			     '("age" . 26))))
+  (json-object? (json-object '(name . "alice")
+			     '(age . 26))))
 
-(test-not "json-object should not meet json-list?"
-  (json-list? (json-object '("x" . 5))))
+(test-assert "json-object should not meet json-list?"
+  (not (json-list? (json-object '(x . 5)))))
 
-(test-not "json-list should not meet json-object?"
-  (json-object? (json-list 1 2 3)))
+(test-assert "json-list should not meet json-object?"
+  (not (json-object? (json-list 1 2 3))))
 
 (test-assert "json-list should meet json-list?"
   (json-list? (json-list)))
@@ -30,46 +30,52 @@
   (json-value? #t))
 
 (test-assert "json-objects should meet json-value?"
-  (json-value? (json-object '("x" . 5))))
+  (json-value? (json-object '(x . 5))))
 
 (test-assert "json-lists should meet json-value?"
   (json-value? (json-list 1 2 3)))
 
 (test-assert "json-object-contains-key? should return true when the object contains the key"
-  (json-object-contains-key? (json-object '("x" . 5)) "x"))
+  (json-object-contains-key? (json-object '(x . 5)) 'x))
 
-(test-not "json-object-contains-key? should return false when the object does not contain the key"
-  (json-object-contains-key? (json-object '("x" . 5)) "y"))
+(test-assert "json-object-contains-key? should return false when the object does not contain the key"
+  (not (json-object-contains-key? (json-object '(x . 5)) 'y)))
 
 (test-assert "the null string should meet json-null? when parsed"
   (json-null? (string->json "null")))
 
-(test "numbers should parse to their scheme values"
+(test-equal "numbers should parse to their scheme values"
       5 (string->json "5"))
 
-(test "true should parse to the boolean true"
+(test-equal "true should parse to the boolean true"
       #t (string->json "true"))
 
-(test "false should parse to the boolean false"
+(test-equal "false should parse to the boolean false"
       #f (string->json "false"))
 
-(test "string->json should properly parse string values"
+(test-equal "string->json should properly parse string values"
       "hello" (string->json "\"hello\""))
 
 (test-assert "string->json should return an object with the correct keys"
-  (json-object-contains-key? (string->json "{\"x\": 5}") "x"))
+  (json-object-contains-key? (string->json "{\"x\": 5}") 'x))
 
-(test-not "string->json should return an object without the incorrect keys"
-  (json-object-contains-key? (string->json "{\"x\": 5}") "y"))
+(test-assert "string->json should return an object without the incorrect keys"
+  (not (json-object-contains-key? (string->json "{\"x\": 5}") 'y)))
 
 (test-assert "json-object-contains-key? should be met when the associated value is false"
-  (json-object-contains-key? (json-object '("x" . #f)) "x"))
+  (json-object-contains-key? (json-object '(x . #f)) 'x))
 
 (test-assert "json-object-contains-key? should be met when the associated value is an empty json-list"
-  (json-object-contains-key? (json-object `("x" . ,(json-list))) "x"))
+  (json-object-contains-key? (json-object `(x . ,(json-list))) 'x))
 
 (test-assert "json-object-contains-key? should be met when the associated value is an empty json-object"
-  (json-object-contains-key? (json-object `("x" . ,(json-object))) "x"))
+  (json-object-contains-key? (json-object `(x . ,(json-object))) 'x))
 
 (test-assert "json-object-contains-key? should be met when the associated value is json-null"
-  (json-object-contains-key? (json-object `("x" . ,json-null)) "x"))
+  (json-object-contains-key? (json-object `(x . ,json-null)) 'x))
+
+;; (json (object))				; => {}
+
+;; (json (list))				; => []
+
+;; (json null)				; => null