summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobby Zambito <contact@robbyzambito.me>2023-02-14 20:53:47 -0500
committerRobby Zambito <contact@robbyzambito.me>2023-02-14 20:53:47 -0500
commitd02631bf16aaaa33212edccfdf304dda94f5ff0f (patch)
tree518f03a39c367538f84cb1ff81a1f2d0842aad2b
parent0a792043c71a7ed457a2dd65930c5c75d1976783 (diff)
Fix Gauche implementation of json-object-ref to reflect string->symbol change.
Add tests to catch this error.
-rw-r--r--lib/zambyte/meta/gauche.scm2
-rw-r--r--test/run.scm15
2 files changed, 16 insertions, 1 deletions
diff --git a/lib/zambyte/meta/gauche.scm b/lib/zambyte/meta/gauche.scm
index 88093e5..7f0a852 100644
--- a/lib/zambyte/meta/gauche.scm
+++ b/lib/zambyte/meta/gauche.scm
@@ -35,7 +35,7 @@
(define json->string construct-json-string)
(define (json-object-ref json key)
- (let ((pair (assoc key json)))
+ (let ((pair (assoc (symbol->string key) json)))
(if pair
(cdr pair)
((json-key-not-found)))))
diff --git a/test/run.scm b/test/run.scm
index 6d8f9f0..a2a515b 100644
--- a/test/run.scm
+++ b/test/run.scm
@@ -74,6 +74,21 @@
(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))
+(test-equal "json-ref should get a value associated with a key in an object"
+ 5 (json-ref (json-object '(x . 5)) 'x))
+
+(test-equal "json-ref should get the value at an index of a list"
+ 5 (json-ref (json-object '(x . 5) '(y . #t)) 'x))
+
+(test-equal "json-ref should get the value at an index of a list"
+ 2 (json-ref (json-list 1 2 3) 1))
+
+(test-equal "json-ref should recursively get a value in a list in an object"
+ json-null (json-ref (json-object `(x . ,(json-list #t json-null #f))) 'x 1))
+
+(test-equal "json-ref should recursively get a value in an object in a list"
+ 5 (json-ref (json-list (json-object) (json-object '(a . 4) '(b . 5) '(c . 6)) #t) 1 'b))
+
;; (json (object)) ; => {}
;; (json (list)) ; => []