diff --git a/json/parser.scm b/json/parser.scm index 8f71415..8b33a22 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)) + (else (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,9 @@ ((eqv? ch #\}) (read-char port) (cond - (added (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 #\") 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}"))