From 0b17e637d3791d1ca94558429f9deba3a5876166 Mon Sep 17 00:00:00 2001 From: Robby Zambito Date: Tue, 14 Feb 2023 20:33:23 -0500 Subject: Use assoc symbols for keys instead of strings for objects. Update the test suite to be more compatible with SRFI 64. --- test/chibi.scm | 11 ++++++++--- test/gauche.scm | 19 +++---------------- test/gerbil.scm | 15 ++++++++------- test/run.scm | 48 +++++++++++++++++++++++++++--------------------- 4 files changed, 46 insertions(+), 47 deletions(-) (limited to 'test') 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 -- cgit