Add some tests

5 files changed, 139 insertions, 0 deletions

diff --git a/run-tests.sh b/run-tests.sh
new file mode 100755
index 0000000..556c8b6
--- /dev/null
+++ b/run-tests.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+
+echo ";;;; Start Chibi"
+chibi-scheme -I ./lib ./test/chibi.scm
+echo ";;;; End Chibi"
+echo ";;;; Start Gauche"
+gosh -r7 -I ./lib ./test/gauche.scm
+echo ";;;; End Gauche"
+echo ";;;; Start Gerbil"
+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
new file mode 100644
index 0000000..2bd9da5
--- /dev/null
+++ b/test/chibi.scm
@@ -0,0 +1,7 @@
+(import (scheme base)
+	(scheme load)
+	(chibi test))
+
+(import (zambyte meta json))
+
+(load "./test/run.scm")
diff --git a/test/gauche.scm b/test/gauche.scm
new file mode 100644
index 0000000..1388b1e
--- /dev/null
+++ b/test/gauche.scm
@@ -0,0 +1,21 @@
+(import (scheme base)
+	(prefix (gauche test) g:))
+
+(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?))))
+
+(include "run.scm")
diff --git a/test/gerbil.scm b/test/gerbil.scm
new file mode 100644
index 0000000..ca730d0
--- /dev/null
+++ b/test/gerbil.scm
@@ -0,0 +1,21 @@
+(import (scheme base)
+	(std test))
+
+(import (zambyte meta json))
+
+(define-syntax test
+  (syntax-rules ()
+    ((_ name expected actual)
+     (test-case name (check-output 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)))))
+
+(include "run.scm")
diff --git a/test/run.scm b/test/run.scm
new file mode 100644
index 0000000..58f1085
--- /dev/null
+++ b/test/run.scm
@@ -0,0 +1,75 @@
+(test-assert "json-object should meet json-object?"
+  (json-object? (json-object)))
+
+(test-assert "json-object should meet json-object?"
+  (json-object? (json-object '("name" . "alice")
+			     '("age" . 26))))
+
+(test-not "json-object should not meet json-list?"
+  (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 meet json-list?"
+  (json-list? (json-list)))
+
+(test-assert "json-list should meet json-list?"
+  (json-list? (json-list "a" 1 #t)))
+
+(test-assert "json-null should meet json-null?"
+  (json-null? json-null))
+
+(test-assert "numbers should meet json-value?"
+  (json-value? 5))
+
+(test-assert "strings should meet json-value?"
+  (json-value? "hello"))
+
+(test-assert "booleans should meet json-value?"
+  (json-value? #t))
+
+(test-assert "json-objects should meet json-value?"
+  (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"))
+
+(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 "the null string should meet json-null? when parsed"
+  (json-null? (string->json "null")))
+
+(test "numbers should parse to their scheme values"
+      5 (string->json "5"))
+
+(test "true should parse to the boolean true"
+      #t (string->json "true"))
+
+(test "false should parse to the boolean false"
+      #f (string->json "false"))
+
+(test "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"))
+
+(test-not "string->json should return an object without the incorrect keys"
+  (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"))
+
+(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"))
+
+(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"))
+
+(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"))