From f0e2fa2d14436e74e0f2f3472901b7141410f375 Mon Sep 17 00:00:00 2001 From: Panagiotis Koutsourakis Date: Wed, 13 Dec 2023 09:49:26 +0200 Subject: [PATCH 1/4] Remove duplicate keys in parsed objects This addresses #84 --- json/parser.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/json/parser.scm b/json/parser.scm index 8f71415..4b94b44 100644 --- a/json/parser.scm +++ b/json/parser.scm @@ -210,6 +210,12 @@ ;; Anything other than colon is an error. (else (json-exception port)))))) +(define (uniquify-keys pairs res) + (cond ((null? pairs) res) + ((assoc (caar pairs) res) + (uniquify-keys (cdr pairs) res)) + (#t (uniquify-keys (cdr pairs) (cons (car pairs) res))))) + (define (json-read-object port null ordered) (expect-delimiter port #\{) (let loop ((pairs '()) (added #t)) @@ -220,7 +226,7 @@ ((eqv? ch #\}) (read-char port) (cond - (added (if ordered (reverse! pairs) pairs)) + (added (uniquify-keys (if ordered (reverse! pairs) pairs) '())) (else (json-exception port)))) ;; Read one pair and continue. ((eqv? ch #\") From a6d4e29f0a9ea23ce2f8b77eaacc7d3bb16a4bfb Mon Sep 17 00:00:00 2001 From: Panagiotis Koutsourakis Date: Fri, 15 Dec 2023 15:33:57 +0200 Subject: [PATCH 2/4] Add a few tests --- tests/test-parser.scm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/test-parser.scm b/tests/test-parser.scm index f1b2920..380e0ba 100644 --- a/tests/test-parser.scm +++ b/tests/test-parser.scm @@ -86,6 +86,7 @@ (test-error #t (json-string->scm "[,1]")) (test-error #t (json-string->scm "[1,2,,,5]")) (test-error #t (json-string->scm "[1,2")) +(test-error #t (json-string->scm "[1,2,]")) ;; Objects (test-equal '() (json-string->scm "{}")) @@ -102,6 +103,11 @@ (test-equal '() (json-string->scm "{}" #:ordered #t)) (test-equal '(("green" . 1) ("eggs" . 2) ("ham" . 3)) (json-string->scm "{\"green\":1, \"eggs\":2, \"ham\":3}" #:ordered #t)) +;; Objects with duplicate keys +(test-equal '(("bar" . 2) ("baz" . #(1 2 3)) ("foo" . "last")) (json-string->scm "{\"foo\": \"first\", \"bar\": 2, \"foo\": \"second\", \"baz\": [1, 2, 3], \"foo\": \"last\"}" #:ordered #t)) + +(test-equal '(("foo" . "last") ("baz" . #(1 2 3)) ("bar" . 2)) (json-string->scm "{\"foo\": \"first\", \"bar\": 2, \"foo\": \"second\", \"baz\": [1, 2, 3], \"foo\": \"last\"}" )) + ;; Since the following JSON object contains more than one key-value pair, we ;; can't use "test-equal" directly since the output could be unordered. (define book (json-string->scm "{\"title\":\"A book\",\"author\":\"An author\",\"price\":29.99}")) From 64e3a407f171b41b5eb0cd0733fc364d2e1d219f Mon Sep 17 00:00:00 2001 From: Panagiotis Koutsourakis Date: Fri, 15 Dec 2023 15:34:17 +0200 Subject: [PATCH 3/4] Handle correctly duplicate keys --- json/parser.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/json/parser.scm b/json/parser.scm index 4b94b44..6e0b2d5 100644 --- a/json/parser.scm +++ b/json/parser.scm @@ -226,7 +226,9 @@ ((eqv? ch #\}) (read-char port) (cond - (added (uniquify-keys (if ordered (reverse! pairs) pairs) '())) + (added (if ordered + (uniquify-keys pairs '()) + (reverse! (uniquify-keys pairs '())))) (else (json-exception port)))) ;; Read one pair and continue. ((eqv? ch #\") From b62f8d7c75a7d8dc9ca84a996bb652041857cdff Mon Sep 17 00:00:00 2001 From: Panagiotis Koutsourakis Date: Thu, 21 Dec 2023 09:00:21 +0200 Subject: [PATCH 4/4] Use the idiomatic else in cond form --- json/parser.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/json/parser.scm b/json/parser.scm index 6e0b2d5..8b33a22 100644 --- a/json/parser.scm +++ b/json/parser.scm @@ -214,7 +214,7 @@ (cond ((null? pairs) res) ((assoc (caar pairs) res) (uniquify-keys (cdr pairs) res)) - (#t (uniquify-keys (cdr pairs) (cons (car pairs) res))))) + (else (uniquify-keys (cdr pairs) (cons (car pairs) res))))) (define (json-read-object port null ordered) (expect-delimiter port #\{)