diff options
| -rw-r--r-- | etc/NEWS | 9 | ||||
| -rw-r--r-- | lisp/json.el | 576 | ||||
| -rw-r--r-- | lisp/jsonrpc.el | 50 | ||||
| -rw-r--r-- | lisp/progmodes/python.el | 21 | ||||
| -rw-r--r-- | test/lisp/json-tests.el | 865 |
5 files changed, 1063 insertions, 458 deletions
@@ -360,6 +360,15 @@ either an internal or external browser. *** New user option 'project-vc-merge-submodules'. +** json.el + +--- +*** JSON number parsing is now stricter. +Numbers with a leading plus sign, leading zeros, or a missing integer +component are now rejected by 'json-read' and friends. This makes +them more compliant with the JSON specification and consistent with +the native JSON parsing functions. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/json.el b/lisp/json.el index 6f3b791ed17..9002e868537 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Theresa O'Connor <ted@oconnor.cx> -;; Version: 1.4 +;; Version: 1.5 ;; Keywords: convenience ;; This file is part of GNU Emacs. @@ -29,11 +29,11 @@ ;; Learn all about JSON here: <URL:http://json.org/>. ;; The user-serviceable entry points for the parser are the functions -;; `json-read' and `json-read-from-string'. The encoder has a single +;; `json-read' and `json-read-from-string'. The encoder has a single ;; entry point, `json-encode'. ;; Since there are several natural representations of key-value pair -;; mappings in elisp (alist, plist, hash-table), `json-read' allows you +;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you ;; to specify which you'd prefer (see `json-object-type' and ;; `json-array-type'). @@ -55,6 +55,7 @@ ;;; Code: (require 'map) +(require 'seq) (require 'subr-x) ;; Parameters @@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.") "If non-nil, then the output of `json-encode' will be pretty-printed.") (defvar json-encoding-lisp-style-closings nil - "If non-nil, ] and } closings will be formatted lisp-style, -without indentation.") + "If non-nil, delimiters ] and } will be formatted Lisp-style. +This means they will be placed on the same line as the last +element of the respective array or object, without indentation. +Used only when `json-encoding-pretty-print' is non-nil.") (defvar json-encoding-object-sort-predicate nil "Sorting predicate for JSON object keys during encoding. @@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object keys ordered alphabetically.") (defvar json-pre-element-read-function nil - "Function called (if non-nil) by `json-read-array' and -`json-read-object' right before reading a JSON array or object, -respectively. The function is called with one argument, which is -the current JSON key.") + "If non-nil, a function to call before reading a JSON array or object. +It is called by `json-read-array' and `json-read-object', +respectively, with one argument, which is the current JSON key.") (defvar json-post-element-read-function nil - "Function called (if non-nil) by `json-read-array' and -`json-read-object' right after reading a JSON array or object, -respectively.") + "If non-nil, a function to call after reading a JSON array or object. +It is called by `json-read-array' and `json-read-object', +respectively, with no arguments.") ;;; Utilities -(defun json-join (strings separator) - "Join STRINGS with SEPARATOR." - (mapconcat 'identity strings separator)) +(define-obsolete-function-alias 'json-join #'string-join "28.1") (defun json-alist-p (list) - "Non-null if and only if LIST is an alist with simple keys." - (while (consp list) - (setq list (if (and (consp (car list)) - (atom (caar list))) - (cdr list) - 'not-alist))) + "Non-nil if and only if LIST is an alist with simple keys." + (declare (pure t) (side-effect-free error-free)) + (while (and (consp (car-safe list)) + (atom (caar list)) + (setq list (cdr list)))) (null list)) (defun json-plist-p (list) - "Non-null if and only if LIST is a plist with keyword keys." - (while (consp list) - (setq list (if (and (keywordp (car list)) - (consp (cdr list))) - (cddr list) - 'not-plist))) + "Non-nil if and only if LIST is a plist with keyword keys." + (declare (pure t) (side-effect-free error-free)) + (while (and (keywordp (car-safe list)) + (consp (cdr list)) + (setq list (cddr list)))) (null list)) -(defun json--plist-reverse (plist) - "Return a copy of PLIST in reverse order. -Unlike `reverse', this keeps the property-value pairs intact." - (let (res) - (while plist - (let ((prop (pop plist)) - (val (pop plist))) - (push val res) - (push prop res))) - res)) - -(defun json--plist-to-alist (plist) - "Return an alist of the property-value pairs in PLIST." - (let (res) - (while plist - (let ((prop (pop plist)) - (val (pop plist))) - (push (cons prop val) res))) - (nreverse res))) - -(defmacro json--with-indentation (body) +(defun json--plist-nreverse (plist) + "Return PLIST in reverse order. +Unlike `nreverse', this keeps the ordering of each property +relative to its value intact. Like `nreverse', this function may +destructively modify PLIST to produce the result." + (let (prev (next (cddr plist))) + (while next + (setcdr (cdr plist) prev) + (setq prev plist plist next next (cddr next)) + (setcdr (cdr plist) prev))) + plist) + +(defmacro json--with-indentation (&rest body) + "Evaluate BODY with the correct indentation for JSON encoding. +This macro binds `json--encoding-current-indentation' according +to `json-encoding-pretty-print' around BODY." + (declare (debug t) (indent 0)) `(let ((json--encoding-current-indentation (if json-encoding-pretty-print (concat json--encoding-current-indentation json-encoding-default-indentation) ""))) - ,body)) + ,@body)) ;; Reader utilities (define-inline json-advance (&optional n) - "Advance N characters forward." + "Advance N characters forward, or 1 character if N is nil. +On reaching the end of the accessible region of the buffer, stop +and signal an error." (inline-quote (forward-char ,n))) (define-inline json-peek () - "Return the character at point." + "Return the character at point. +At the end of the accessible region of the buffer, return 0." (inline-quote (following-char))) (define-inline json-pop () - "Advance past the character at point, returning it." + "Advance past the character at point, returning it. +Signal `json-end-of-file' if called at the end of the buffer." (inline-quote - (let ((char (json-peek))) - (if (zerop char) - (signal 'json-end-of-file nil) - (json-advance) - char)))) + (prog1 (or (char-after) + (signal 'json-end-of-file ())) + (json-advance)))) (define-inline json-skip-whitespace () "Skip past the whitespace at point." @@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs intact." ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf ;; or https://tools.ietf.org/html/rfc7159#section-2 for the ;; definition of whitespace in JSON. - (inline-quote (skip-chars-forward "\t\r\n "))) + (inline-quote (skip-chars-forward "\t\n\r "))) @@ -236,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs intact." ;;; Paths (defvar json--path '() - "Used internally by `json-path-to-position' to keep track of -the path during recursive calls to `json-read'.") + "Keeps track of the path during recursive calls to `json-read'. +Used internally by `json-path-to-position'.") (defun json--record-path (key) "Record the KEY to the current JSON path. @@ -248,7 +244,7 @@ Used internally by `json-path-to-position'." "Check if the last parsed JSON structure passed POSITION. Used internally by `json-path-to-position'." (let ((start (caar json--path))) - (when (< start position (+ (point) 1)) + (when (< start position (1+ (point))) (throw :json-path (list :path (nreverse (mapcar #'cdr json--path)) :match-start start :match-end (point))))) @@ -266,13 +262,13 @@ properties: :path -- A list of strings and numbers forming the path to the JSON element at the given position. Strings denote object names, while numbers denote array - indexes. + indices. :match-start -- Position where the matched JSON element begins. :match-end -- Position where the matched JSON element ends. -This can for instance be useful to determine the path to a JSON +This can, for instance, be useful to determine the path to a JSON element in a deeply nested structure." (save-excursion (unless string @@ -280,7 +276,7 @@ element in a deeply nested structure." (let* ((json--path '()) (json-pre-element-read-function #'json--record-path) (json-post-element-read-function - (apply-partially #'json--check-position position)) + (lambda () (json--check-position position))) (path (catch :json-path (if string (json-read-from-string string) @@ -290,38 +286,33 @@ element in a deeply nested structure." ;;; Keywords -(defvar json-keywords '("true" "false" "null") +(defconst json-keywords '("true" "false" "null") "List of JSON keywords.") +(make-obsolete-variable 'json-keywords "it is no longer used." "28.1") ;; Keyword parsing +;; Characters that can follow a JSON value. +(rx-define json--post-value (| (in "\t\n\r ,]}") eos)) + (defun json-read-keyword (keyword) - "Read a JSON keyword at point. -KEYWORD is the keyword expected." - (unless (member keyword json-keywords) - (signal 'json-unknown-keyword (list keyword))) - (mapc (lambda (char) - (when (/= char (json-peek)) - (signal 'json-unknown-keyword - (list (save-excursion - (backward-word-strictly 1) - (thing-at-point 'word))))) - (json-advance)) - keyword) - (json-skip-whitespace) - (unless (looking-at "\\([],}]\\|$\\)") - (signal 'json-unknown-keyword - (list (save-excursion - (backward-word-strictly 1) - (thing-at-point 'word))))) - (cond ((string-equal keyword "true") t) - ((string-equal keyword "false") json-false) - ((string-equal keyword "null") json-null))) + "Read the expected JSON KEYWORD at point." + (prog1 (cond ((equal keyword "true") t) + ((equal keyword "false") json-false) + ((equal keyword "null") json-null) + (t (signal 'json-unknown-keyword (list keyword)))) + (or (looking-at-p keyword) + (signal 'json-unknown-keyword (list (thing-at-point 'word)))) + (json-advance (length keyword)) + (or (looking-at-p (rx json--post-value)) + (signal 'json-unknown-keyword (list (thing-at-point 'word)))) + (json-skip-whitespace))) ;; Keyword encoding (defun json-encode-keyword (keyword) "Encode KEYWORD as a JSON value." + (declare (side-effect-free t)) (cond ((eq keyword t) "true") ((eq keyword json-false) "false") ((eq keyword json-null) "null"))) @@ -330,37 +321,31 @@ KEYWORD is the keyword expected." ;; Number parsing -(defun json-read-number (&optional sign) - "Read the JSON number following point. -The optional SIGN argument is for internal use. - -N.B.: Only numbers which can fit in Emacs Lisp's native number -representation will be parsed correctly." - ;; If SIGN is non-nil, the number is explicitly signed. - (let ((number-regexp - "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?")) - (cond ((and (null sign) (= (json-peek) ?-)) - (json-advance) - (- (json-read-number t))) - ((and (null sign) (= (json-peek) ?+)) - (json-advance) - (json-read-number t)) - ((and (looking-at number-regexp) - (or (match-beginning 1) - (match-beginning 2))) - (goto-char (match-end 0)) - (string-to-number (match-string 0))) - (t (signal 'json-number-format (list (point))))))) +(rx-define json--number + (: (? ?-) ; Sign. + (| (: (in "1-9") (* digit)) ?0) ; Integer. + (? ?. (+ digit)) ; Fraction. + (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent. + +(defun json-read-number (&optional _sign) + "Read the JSON number following point." + (declare (advertised-calling-convention () "28.1")) + (or (looking-at (rx json--number)) + (signal 'json-number-format (list (point)))) + (goto-char (match-end 0)) + (prog1 (string-to-number (match-string 0)) + (or (looking-at-p (rx json--post-value)) + (signal 'json-number-format (list (point)))) + (json-skip-whitespace))) ;; Number encoding -(defun json-encode-number (number) - "Return a JSON representation of NUMBER." - (format "%s" number)) +(defalias 'json-encode-number #'number-to-string + "Return a JSON representation of NUMBER.") ;;; Strings -(defvar json-special-chars +(defconst json-special-chars '((?\" . ?\") (?\\ . ?\\) (?b . ?\b) @@ -368,7 +353,7 @@ representation will be parsed correctly." (?n . ?\n) (?r . ?\r) (?t . ?\t)) - "Characters which are escaped in JSON, with their elisp counterparts.") + "Characters which are escaped in JSON, with their Elisp counterparts.") ;; String parsing @@ -378,48 +363,47 @@ representation will be parsed correctly." (defun json-read-escaped-char () "Read the JSON string escaped character at point." - ;; Skip over the '\' + ;; Skip over the '\'. (json-advance) - (let* ((char (json-pop)) - (special (assq char json-special-chars))) + (let ((char (json-pop))) (cond - (special (cdr special)) - ((not (eq char ?u)) char) + ((cdr (assq char json-special-chars))) + ((/= char ?u) char) ;; Special-case UTF-16 surrogate pairs, ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that ;; this clause overlaps with the next one and therefore has to ;; come first. ((looking-at - (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit))) - "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit))))) + (rx (group (any "Dd") (any "89ABab") (= 2 xdigit)) + "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit)))) (json-advance 10) (json--decode-utf-16-surrogates (string-to-number (match-string 1) 16) (string-to-number (match-string 2) 16))) ((looking-at (rx (= 4 xdigit))) - (let ((hex (match-string 0))) - (json-advance 4) - (string-to-number hex 16))) + (json-advance 4) + (string-to-number (match-string 0) 16)) (t (signal 'json-string-escape (list (point))))))) (defun json-read-string () "Read the JSON string at point." - (unless (= (json-peek) ?\") - (signal 'json-string-format (list "doesn't start with `\"'!"))) - ;; Skip over the '"' + ;; Skip over the '"'. (json-advance) (let ((characters '()) (char (json-peek))) - (while (not (= char ?\")) + (while (/= char ?\") (when (< char 32) - (signal 'json-string-format (list (prin1-char char)))) + (if (zerop char) + (signal 'json-end-of-file ()) + (signal 'json-string-format (list char)))) (push (if (= char ?\\) (json-read-escaped-char) - (json-pop)) + (json-advance) + char) characters) (setq char (json-peek))) - ;; Skip over the '"' + ;; Skip over the '"'. (json-advance) (if characters (concat (nreverse characters)) @@ -427,29 +411,47 @@ representation will be parsed correctly." ;; String encoding +;; Escape only quotation mark, backslash, and the control +;; characters U+0000 to U+001F (RFC 4627, ECMA-404). +(rx-define json--escape (in ?\" ?\\ cntrl)) + +(defvar json--long-string-threshold 200 + "Length above which strings are considered long for JSON encoding. +It is generally faster to manipulate such strings in a buffer +rather than directly.") + +(defvar json--string-buffer nil + "Buffer used for encoding Lisp strings as JSON. +Initialized lazily by `json-encode-string'.") + (defun json-encode-string (string) "Return a JSON representation of STRING." - ;; Reimplement the meat of `replace-regexp-in-string', for - ;; performance (bug#20154). - (let ((l (length string)) - (start 0) - res mb) - ;; Only escape quotation mark, backslash and the control - ;; characters U+0000 to U+001F (RFC 4627, ECMA-404). - (while (setq mb (string-match "[\"\\[:cntrl:]]" string start)) - (let* ((c (aref string mb)) - (special (rassq c json-special-chars))) - (push (substring string start mb) res) - (push (if special - ;; Special JSON character (\n, \r, etc.). - (string ?\\ (car special)) - ;; Fallback: UCS code point in \uNNNN form. - (format "\\u%04x" c)) - res) - (setq start (1+ mb)))) - (push (substring string start l) res) - (push "\"" res) - (apply #'concat "\"" (nreverse res)))) + ;; Try to avoid buffer overhead in trivial cases, while also + ;; avoiding searching pathological strings for escape characters. + ;; Since `string-match-p' doesn't take a LIMIT argument, we use + ;; string length as our heuristic. See also bug#20154. + (if (and (< (length string) json--long-string-threshold) + (not (string-match-p (rx json--escape) string))) + (concat "\"" string "\"") + (with-current-buffer + (or json--string-buffer + (with-current-buffer (generate-new-buffer " *json-string*") + ;; This seems to afford decent performance gains. + (setq-local inhibit-modification-hooks t) + (setq json--string-buffer (current-buffer)))) + (insert ?\" string) + (goto-char (1+ (point-min))) + (while (re-search-forward (rx json--escape) nil 'move) + (let ((char (preceding-char))) + (delete-char -1) + (insert ?\\ (or + ;; Special JSON character (\n, \r, etc.). + (car (rassq char json-special-chars)) + ;; Fallback: UCS code point in \uNNNN form. + (format "u%04x" char))))) + (insert ?\") + ;; Empty buffer for next invocation. + (delete-and-extract-region (point-min) (point-max))))) (defun json-encode-key (object) "Return a JSON representation of OBJECT. @@ -460,15 +462,13 @@ this signals `json-key-format'." (signal 'json-key-format (list object))) encoded)) -;;; JSON Objects +;;; Objects (defun json-new-object () - "Create a new Elisp object corresponding to a JSON object. + "Create a new Elisp object corresponding to an empty JSON object. Please see the documentation of `json-object-type'." - (cond ((eq json-object-type 'hash-table) - (make-hash-table :test 'equal)) - (t - ()))) + (and (eq json-object-type 'hash-table) + (make-hash-table :test #'equal))) (defun json-add-to-object (object key value) "Add a new KEY -> VALUE association to OBJECT. @@ -476,10 +476,10 @@ Returns the updated object, which you should save, e.g.: (setq obj (json-add-to-object obj \"foo\" \"bar\")) Please see the documentation of `json-object-type' and `json-key-type'." (let ((json-key-type - (or json-key-type - (cdr (assq json-object-type '((hash-table . string) - (alist . symbol) - (plist . keyword))))))) + (cond (json-key-type) + ((eq json-object-type 'hash-table) 'string) + ((eq json-object-type 'alist) 'symbol) + ((eq json-object-type 'plist) 'keyword)))) (setq key (cond ((eq json-key-type 'string) key) @@ -499,13 +499,13 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-read-object () "Read the JSON object at point." - ;; Skip over the "{" + ;; Skip over the '{'. (json-advance) (json-skip-whitespace) - ;; read key/value pairs until "}" + ;; Read key/value pairs until '}'. (let ((elements (json-new-object)) key value) - (while (not (= (json-peek) ?})) + (while (/= (json-peek) ?\}) (json-skip-whitespace) (setq key (json-read-string)) (json-skip-whitespace) @@ -520,94 +520,94 @@ Please see the documentation of `json-object-type' and `json-key-type'." (funcall json-post-element-read-function)) (setq elements (json-add-to-object elements key value)) (json-skip-whitespace) - (when (/= (json-peek) ?}) + (when (/= (json-peek) ?\}) (if (= (json-peek) ?,) (json-advance) (signal 'json-object-format (list "," (json-peek)))))) - ;; Skip over the "}" + ;; Skip over the '}'. (json-advance) (pcase json-object-type ('alist (nreverse elements)) - ('plist (json--plist-reverse elements)) + ('plist (json--plist-nreverse elements)) (_ elements)))) ;; Hash table encoding (defun json-encode-hash-table (hash-table) "Return a JSON representation of HASH-TABLE." - (if json-encoding-object-sort-predicate - (json-encode-alist (map-into hash-table 'list)) - (format "{%s%s}" - (json-join - (let (r) - (json--with-indentation - (maphash - (lambda (k v) - (push (format - (if json-encoding-pretty-print - "%s%s: %s" - "%s%s:%s") - json--encoding-current-indentation - (json-encode-key k) - (json-encode v)) - r)) - hash-table)) - r) - json-encoding-separator) - (if (or (not json-encoding-pretty-print) - json-encoding-lisp-style-closings) - "" - json--encoding-current-indentation)))) + (cond ((hash-table-empty-p hash-table) "{}") + (json-encoding-object-sort-predicate + (json--encode-alist (map-pairs hash-table) t)) + (t + (let ((kv-sep (if json-encoding-pretty-print ": " ":")) + result) + (json--with-indentation + (maphash + (lambda (k v) + (push (concat json--encoding-current-indentation + (json-encode-key k) + kv-sep + (json-encode v)) + result)) + hash-table)) + (concat "{" + (string-join (nreverse result) json-encoding-separator) + (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings) + json--encoding-current-indentation) + "}"))))) ;; List encoding (including alists and plists) -(defun json-encode-alist (alist) - "Return a JSON representation of ALIST." +(defun json--encode-alist (alist &optional destructive) + "Return a JSON representation of ALIST. +DESTRUCTIVE non-nil means it is safe to modify ALIST by +side-effects." (when json-encoding-object-sort-predicate - (setq alist - (sort alist (lambda (a b) + (setq alist (sort (if destructive alist (copy-sequence alist)) + (lambda (a b) (funcall json-encoding-object-sort-predicate (car a) (car b)))))) - (format "{%s%s}" - (json-join - (json--with-indentation - (mapcar (lambda (cons) - (format (if json-encoding-pretty-print - "%s%s: %s" - "%s%s:%s") - json--encoding-current-indentation - (json-encode-key (car cons)) - (json-encode (cdr cons)))) - alist)) - json-encoding-separator) - (if (or (not json-encoding-pretty-print) - json-encoding-lisp-style-closings) - "" - json--encoding-current-indentation))) + (concat "{" + (let ((kv-sep (if json-encoding-pretty-print ": " ":"))) + (json--with-indentation + (mapconcat (lambda (cons) + (concat json--encoding-current-indentation + (json-encode-key (car cons)) + kv-sep + (json-encode (cdr cons)))) + alist + json-encoding-separator))) + (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings) + json--encoding-current-indentation) + "}")) + +(defun json-encode-alist (alist) + "Return a JSON representation of ALIST." + (if alist (json--encode-alist alist) "{}")) (defun json-encode-plist (plist) "Return a JSON representation of PLIST." - (if json-encoding-object-sort-predicate - (json-encode-alist (json--plist-to-alist plist)) - (let (result) - (json--with-indentation - (while plist - (push (concat - json--encoding-current-indentation - (json-encode-key (car plist)) - (if json-encoding-pretty-print - ": " - ":") - (json-encode (cadr plist))) + (cond ((null plist) "{}") + (json-encoding-object-sort-predicate + (json--encode-alist (map-pairs plist) t)) + (t + (let ((kv-sep (if json-encoding-pretty-print ": " ":")) result) - (setq plist (cddr plist)))) - (concat "{" - (json-join (nreverse result) json-encoding-separator) - (if (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings)) - json--encoding-current-indentation - "") - "}")))) + (json--with-indentation + (while plist + (push (concat json--encoding-current-indentation + (json-encode-key (pop plist)) + kv-sep + (json-encode (pop plist))) + result))) + (concat "{" + (string-join (nreverse result) json-encoding-separator) + (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings) + json--encoding-current-indentation) + "}"))))) (defun json-encode-list (list) "Return a JSON representation of LIST. @@ -625,15 +625,17 @@ become JSON objects." (defun json-read-array () "Read the JSON array at point." - ;; Skip over the "[" + ;; Skip over the '['. (json-advance) (json-skip-whitespace) - ;; read values until "]" - (let (elements) - (while (not (= (json-peek) ?\])) + ;; Read values until ']'. + (let (elements + (len 0)) + (while (/= (json-peek) ?\]) (json-skip-whitespace) (when json-pre-element-read-function - (funcall json-pre-element-read-function (length elements))) + (funcall json-pre-element-read-function len) + (setq len (1+ len))) (push (json-read) elements) (when json-post-element-read-function (funcall json-post-element-read-function)) @@ -641,8 +643,8 @@ become JSON objects." (when (/= (json-peek) ?\]) (if (= (json-peek) ?,) (json-advance) - (signal 'json-array-format (list ?, (json-peek)))))) - ;; Skip over the "]" + (signal 'json-array-format (list "," (json-peek)))))) + ;; Skip over the ']'. (json-advance) (pcase json-array-type ('vector (nreverse (vconcat elements))) @@ -653,42 +655,43 @@ become JSON objects." (defun json-encode-array (array) "Return a JSON representation of ARRAY." (if (and json-encoding-pretty-print - (> (length array) 0)) + (not (seq-empty-p array))) (concat + "[" (json--with-indentation - (concat (format "[%s" json--encoding-current-indentation) - (json-join (mapcar 'json-encode array) - (format "%s%s" - json-encoding-separator + (concat json--encoding-current-indentation + (mapconcat #'json-encode array + (concat json-encoding-separator json--encoding-current-indentation)))) - (format "%s]" - (if json-encoding-lisp-style-closings - "" - json--encoding-current-indentation))) + (unless json-encoding-lisp-style-closings + json--encoding-current-indentation) + "]") (concat "[" - (mapconcat 'json-encode array json-encoding-separator) + (mapconcat #'json-encode array json-encoding-separator) "]"))) -;;; JSON reader. +;;; Reader (defmacro json-readtable-dispatch (char) - "Dispatch reader function for CHAR." - (declare (debug (symbolp))) - (let ((table - '((?t json-read-keyword "true") - (?f json-read-keyword "false") - (?n json-read-keyword "null") - (?{ json-read-object) - (?\[ json-read-array) - (?\" json-read-string))) - res) - (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - (push (list c 'json-read-number) table)) - (pcase-dolist (`(,c . ,rest) table) - (push `((eq ,char ,c) (,@rest)) res)) - `(cond ,@res (t (signal 'json-readtable-error (list ,char)))))) + "Dispatch reader function for CHAR at point. +If CHAR is nil, signal `json-end-of-file'." + (declare (debug t)) + (macroexp-let2 nil char char + `(cond ,@(map-apply + (lambda (key expr) + `((eq ,char ,key) ,expr)) + `((?\" ,#'json-read-string) + (?\[ ,#'json-read-array) + (?\{ ,#'json-read-object) + (?n ,#'json-read-keyword "null") + (?f ,#'json-read-keyword "false") + (?t ,#'json-read-keyword "true") + ,@(mapcar (lambda (c) (list c #'json-read-number)) + '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))) + (,char (signal 'json-readtable-error (list ,char))) + (t (signal 'json-end-of-file ()))))) (defun json-read () "Parse and return the JSON object following point. @@ -706,10 +709,7 @@ you will get the following structure returned: ((c . :json-false))]) (b . \"foo\"))" (json-skip-whitespace) - (let ((char (json-peek))) - (if (zerop char) - (signal 'json-end-of-file nil) - (json-readtable-dispatch char)))) + (json-readtable-dispatch (char-after))) ;; Syntactic sugar for the reader @@ -724,12 +724,11 @@ you will get the following structure returned: "Read the first JSON object contained in FILE and return it." (with-temp-buffer (insert-file-contents file) - (goto-char (point-min)) (json-read))) -;;; JSON encoder +;;; Encoder (defun json-encode (object) "Return a JSON representation of OBJECT as a string. @@ -737,20 +736,21 @@ you will get the following structure returned: OBJECT should have a structure like one returned by `json-read'. If an error is detected during encoding, an error based on `json-error' is signaled." - (cond ((memq object (list t json-null json-false)) - (json-encode-keyword object)) - ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) - ((listp object) (json-encode-list object)) - ((symbolp object) (json-encode-string - (symbol-name object))) - ((numberp object) (json-encode-number object)) - ((arrayp object) (json-encode-array object)) - ((hash-table-p object) (json-encode-hash-table object)) - (t (signal 'json-error (list object))))) - -;; Pretty printing & minimizing + (cond ((eq object t) (json-encode-keyword object)) + ((eq object json-null) (json-encode-keyword object)) + ((eq object json-false) (json-encode-keyword object)) + ((stringp object) (json-encode-string object)) + ((keywordp object) (json-encode-string + (substring (symbol-name object) 1))) + ((listp object) (json-encode-list object)) + ((symbolp object) (json-encode-string + (symbol-name object))) + ((numberp object) (json-encode-number object)) + ((arrayp object) (json-encode-array object)) + ((hash-table-p object) (json-encode-hash-table object)) + (t (signal 'json-error (list object))))) + +;;; Pretty printing & minimizing (defun json-pretty-print-buffer (&optional minimize) "Pretty-print current buffer. @@ -769,9 +769,9 @@ MAX-SECS.") With prefix argument MINIMIZE, minimize it instead." (interactive "r\nP") (let ((json-encoding-pretty-print (null minimize)) - ;; Distinguish an empty objects from 'null' + ;; Distinguish an empty object from 'null'. (json-null :json-null) - ;; Ensure that ordering is maintained + ;; Ensure that ordering is maintained. (json-object-type 'alist) (orig-buf (current-buffer)) error) @@ -800,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead." ;; them. (let ((space (buffer-substring (point) - (+ (point) - (skip-chars-forward - " \t\n" (point-max))))) + (+ (point) (skip-chars-forward " \t\n")))) (json (json-read))) (setq pos (point)) ; End of last good json-read. (set-buffer tmp-buf) @@ -832,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead." "Pretty-print current buffer with object keys ordered. With prefix argument MINIMIZE, minimize it instead." (interactive "P") - (let ((json-encoding-object-sort-predicate 'string<)) + (let ((json-encoding-object-sort-predicate #'string<)) (json-pretty-print-buffer minimize))) (defun json-pretty-print-ordered (begin end &optional minimize) "Pretty-print the region with object keys ordered. With prefix argument MINIMIZE, minimize it instead." (interactive "r\nP") - (let ((json-encoding-object-sort-predicate 'string<)) + (let ((json-encoding-object-sort-predicate #'string<)) (json-pretty-print begin end minimize))) (provide 'json) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 293dfaa7483..42e7701af18 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -37,7 +37,6 @@ ;;; Code: (require 'cl-lib) -(require 'json) (require 'eieio) (eval-when-compile (require 'subr-x)) (require 'warnings) @@ -470,26 +469,35 @@ With optional CLEANUP, kill any associated buffers." ;;; (define-error 'jsonrpc-error "jsonrpc-error") -(defun jsonrpc--json-read () - "Read JSON object in buffer, move point to end of buffer." - ;; TODO: I guess we can make these macros if/when jsonrpc.el - ;; goes into Emacs core. - (cond ((fboundp 'json-parse-buffer) (json-parse-buffer - :object-type 'plist - :null-object nil - :false-object :json-false)) - (t (let ((json-object-type 'plist)) - (json-read))))) - -(defun jsonrpc--json-encode (object) - "Encode OBJECT into a JSON string." - (cond ((fboundp 'json-serialize) (json-serialize - object - :false-object :json-false - :null-object nil)) - (t (let ((json-false :json-false) - (json-null nil)) - (json-encode object))))) +(defalias 'jsonrpc--json-read + (if (fboundp 'json-parse-buffer) + (lambda () + (json-parse-buffer :object-type 'plist + :null-object nil + :false-object :json-false)) + (require 'json) + (defvar json-object-type) + (declare-function json-read "json" ()) + (lambda () + (let ((json-object-type 'plist)) + (json-read)))) + "Read JSON object in buffer, move point to end of buffer.") + +(defalias 'jsonrpc--json-encode + (if (fboundp 'json-serialize) + (lambda (object) + (json-serialize object + :false-object :json-false + :null-object nil)) + (require 'json) + (defvar json-false) + (defvar json-null) + (declare-function json-encode "json" (object)) + (lambda (object) + (let ((json-false :json-false) + (json-null nil)) + (json-encode object)))) + "Encode OBJECT into a JSON string.") (cl-defun jsonrpc--reply (connection id &key (result nil result-supplied-p) (error nil error-supplied-p)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 67383b34154..1ca9f019638 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -261,7 +261,6 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) -(require 'json) (require 'tramp-sh) ;; Avoid compiler warnings @@ -2276,6 +2275,18 @@ Do not set this variable directly, instead use Do not set this variable directly, instead use `python-shell-prompt-set-calculated-regexps'.") +(defalias 'python--parse-json-array + (if (fboundp 'json-parse-string) + (lambda (string) + (json-parse-string string :array-type 'list)) + (require 'json) + (defvar json-array-type) + (declare-function json-read-from-string "json" (string)) + (lambda (string) + (let ((json-array-type 'list)) + (json-read-from-string string)))) + "Parse the JSON array in STRING into a Lisp list.") + (defun python-shell-prompt-detect () "Detect prompts for the current `python-shell-interpreter'. When prompts can be retrieved successfully from the @@ -2324,11 +2335,11 @@ detection and just returns nil." (catch 'prompts (dolist (line (split-string output "\n" t)) (let ((res - ;; Check if current line is a valid JSON array - (and (string= (substring line 0 2) "[\"") + ;; Check if current line is a valid JSON array. + (and (string-prefix-p "[\"" line) (ignore-errors - ;; Return prompts as a list, not vector - (append (json-read-from-string line) nil))))) + ;; Return prompts as a list. + (python--parse-json-array line))))) ;; The list must contain 3 strings, where the first ;; is the input prompt, the second is the block ;; prompt and the last one is the output prompt. The diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index ac9706a8ae7..a0e8c87c7b3 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -21,11 +21,16 @@ (require 'ert) (require 'json) +(require 'map) +(require 'seq) + +(eval-when-compile + (require 'cl-lib)) (defmacro json-tests--with-temp-buffer (content &rest body) "Create a temporary buffer with CONTENT and evaluate BODY there. Point is moved to beginning of the buffer." - (declare (indent 1)) + (declare (debug t) (indent 1)) `(with-temp-buffer (insert ,content) (goto-char (point-min)) @@ -33,66 +38,107 @@ Point is moved to beginning of the buffer." ;;; Utilities -(ert-deftest test-json-join () - (should (equal (json-join '() ", ") "")) - (should (equal (json-join '("a" "b" "c") ", ") "a, b, c"))) - (ert-deftest test-json-alist-p () (should (json-alist-p '())) - (should (json-alist-p '((a 1) (b 2) (c 3)))) - (should (json-alist-p '((:a 1) (:b 2) (:c 3)))) - (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3)))) + (should (json-alist-p '((())))) + (should (json-alist-p '((a)))) + (should (json-alist-p '((a . 1)))) + (should (json-alist-p '((a . 1) (b 2) (c)))) + (should (json-alist-p '((:a) (:b 2) (:c . 3)))) + (should (json-alist-p '(("a" . 1) ("b" 2) ("c")))) + (should-not (json-alist-p '(()))) + (should-not (json-alist-p '(a))) + (should-not (json-alist-p '(a . 1))) + (should-not (json-alist-p '((a . 1) . []))) + (should-not (json-alist-p '((a . 1) []))) (should-not (json-alist-p '(:a :b :c))) (should-not (json-alist-p '(:a 1 :b 2 :c 3))) - (should-not (json-alist-p '((:a 1) (:b 2) 3)))) + (should-not (json-alist-p '((:a 1) (:b 2) 3))) + (should-not (json-alist-p '((:a 1) (:b 2) ()))) + (should-not (json-alist-p '(((a) 1) (b 2) (c 3)))) + (should-not (json-alist-p [])) + (should-not (json-alist-p [(a . 1)])) + (should-not (json-alist-p #s(hash-table)))) (ert-deftest test-json-plist-p () (should (json-plist-p '())) + (should (json-plist-p '(:a 1))) (should (json-plist-p '(:a 1 :b 2 :c 3))) + (should (json-plist-p '(:a :b))) + (should (json-plist-p '(:a :b :c :d))) + (should-not (json-plist-p '(a))) + (should-not (json-plist-p '(a 1))) (should-not (json-plist-p '(a 1 b 2 c 3))) (should-not (json-plist-p '("a" 1 "b" 2 "c" 3))) + (should-not (json-plist-p '(:a))) (should-not (json-plist-p '(:a :b :c))) - (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))) - -(ert-deftest test-json-plist-reverse () - (should (equal (json--plist-reverse '()) '())) - (should (equal (json--plist-reverse '(:a 1)) '(:a 1))) - (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3)) + (should-not (json-plist-p '(:a 1 :b 2 :c))) + (should-not (json-plist-p '((:a 1)))) + (should-not (json-plist-p '((:a 1) (:b 2) (:c 3)))) + (should-not (json-plist-p [])) + (should-not (json-plist-p [:a 1])) + (should-not (json-plist-p #s(hash-table)))) + +(ert-deftest test-json-plist-nreverse () + (should (equal (json--plist-nreverse '()) '())) + (should (equal (json--plist-nreverse (list :a 1)) '(:a 1))) + (should (equal (json--plist-nreverse (list :a 1 :b 2)) '(:b 2 :a 1))) + (should (equal (json--plist-nreverse (list :a 1 :b 2 :c 3)) '(:c 3 :b 2 :a 1)))) -(ert-deftest test-json-plist-to-alist () - (should (equal (json--plist-to-alist '()) '())) - (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1)))) - (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) - '((:a . 1) (:b . 2) (:c . 3))))) - (ert-deftest test-json-advance () (json-tests--with-temp-buffer "{ \"a\": 1 }" (json-advance 0) - (should (= (point) (point-min))) + (should (bobp)) + (json-advance) + (should (= (point) (1+ (point-min)))) + (json-advance 0) + (should (= (point) (1+ (point-min)))) + (json-advance 1) + (should (= (point) (+ (point-min) 2))) (json-advance 3) - (should (= (point) (+ (point-min) 3))))) + (should (= (point) (+ (point-min) 5))))) (ert-deftest test-json-peek () (json-tests--with-temp-buffer "" (should (zerop (json-peek)))) (json-tests--with-temp-buffer "{ \"a\": 1 }" - (should (equal (json-peek) ?{)))) + (should (= (json-peek) ?\{)) + (goto-char (1- (point-max))) + (should (= (json-peek) ?\})) + (json-advance) + (should (zerop (json-peek))))) (ert-deftest test-json-pop () (json-tests--with-temp-buffer "" (should-error (json-pop) :type 'json-end-of-file)) (json-tests--with-temp-buffer "{ \"a\": 1 }" - (should (equal (json-pop) ?{)) - (should (= (point) (+ (point-min) 1))))) + (should (= (json-pop) ?\{)) + (should (= (point) (1+ (point-min)))) + (goto-char (1- (point-max))) + (should (= (json-pop) ?\})) + (should-error (json-pop) :type 'json-end-of-file))) (ert-deftest test-json-skip-whitespace () + (json-tests--with-temp-buffer "" + (json-skip-whitespace) + (should (bobp)) + (should (eobp))) + (json-tests--with-temp-buffer "{}" + (json-skip-whitespace) + (should (bobp)) + (json-advance) + (json-skip-whitespace) + (should (= (point) (1+ (point-min)))) + (json-advance) + (json-skip-whitespace) + (should (eobp))) (json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }" (json-skip-whitespace) - (should (equal (char-after) ?\f))) + (should (= (json-peek) ?\f))) (json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }" (json-skip-whitespace) - (should (equal (char-after) ?{)))) + (should (= (json-peek) ?\{)))) ;;; Paths @@ -113,59 +159,243 @@ Point is moved to beginning of the buffer." (ert-deftest test-json-path-to-position-no-match () (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}") (matched-path (json-path-to-position 5 json-string))) - (should (null matched-path)))) + (should-not matched-path))) ;;; Keywords (ert-deftest test-json-read-keyword () (json-tests--with-temp-buffer "true" - (should (json-read-keyword "true"))) + (should (eq (json-read-keyword "true") t)) + (should (eobp))) + (json-tests--with-temp-buffer "true " + (should (eq (json-read-keyword "true") t)) + (should (eobp))) + (json-tests--with-temp-buffer "true}" + (should (eq (json-read-keyword "true") t)) + (should (= (point) (+ (point-min) 4)))) + (json-tests--with-temp-buffer "true false" + (should (eq (json-read-keyword "true") t)) + (should (= (point) (+ (point-min) 5)))) + (json-tests--with-temp-buffer "true }" + (should (eq (json-read-keyword "true") t)) + (should (= (point) (+ (point-min) 5)))) + (json-tests--with-temp-buffer "true |" + (should (eq (json-read-keyword "true") t)) + (should (= (point) (+ (point-min) 5)))) + (json-tests--with-temp-buffer "false" + (let ((json-false 'false)) + (should (eq (json-read-keyword "false") 'false))) + (should (eobp))) + (json-tests--with-temp-buffer "null" + (let ((json-null 'null)) + (should (eq (json-read-keyword "null") 'null))) + (should (eobp)))) + +(ert-deftest test-json-read-keyword-invalid () + (json-tests--with-temp-buffer "" + (should (equal (should-error (json-read-keyword "")) + '(json-unknown-keyword ""))) + (should (equal (should-error (json-read-keyword "true")) + '(json-unknown-keyword ())))) (json-tests--with-temp-buffer "true" - (should-error - (json-read-keyword "false") :type 'json-unknown-keyword)) + (should (equal (should-error (json-read-keyword "false")) + '(json-unknown-keyword "true")))) (json-tests--with-temp-buffer "foo" - (should-error - (json-read-keyword "foo") :type 'json-unknown-keyword))) + (should (equal (should-error (json-read-keyword "foo")) + '(json-unknown-keyword "foo"))) + (should (equal (should-error (json-read-keyword "bar")) + '(json-unknown-keyword "bar")))) + (json-tests--with-temp-buffer " true" + (should (equal (should-error (json-read-keyword "true")) + '(json-unknown-keyword ())))) + (json-tests--with-temp-buffer "truefalse" + (should (equal (should-error (json-read-keyword "true")) + '(json-unknown-keyword "truefalse")))) + (json-tests--with-temp-buffer "true|" + (should (equal (should-error (json-read-keyword "true")) + '(json-unknown-keyword "true"))))) (ert-deftest test-json-encode-keyword () (should (equal (json-encode-keyword t) "true")) - (should (equal (json-encode-keyword json-false) "false")) - (should (equal (json-encode-keyword json-null) "null"))) + (let ((json-false 'false)) + (should (equal (json-encode-keyword 'false) "false")) + (should (equal (json-encode-keyword json-false) "false"))) + (let ((json-null 'null)) + (should (equal (json-encode-keyword 'null) "null")) + (should (equal (json-encode-keyword json-null) "null")))) ;;; Numbers -(ert-deftest test-json-read-number () - (json-tests--with-temp-buffer "3" - (should (= (json-read-number) 3))) - (json-tests--with-temp-buffer "-5" - (should (= (json-read-number) -5))) - (json-tests--with-temp-buffer "123.456" - (should (= (json-read-number) 123.456))) - (json-tests--with-temp-buffer "1e3" - (should (= (json-read-number) 1e3))) - (json-tests--with-temp-buffer "2e+3" - (should (= (json-read-number) 2e3))) - (json-tests--with-temp-buffer "3E3" - (should (= (json-read-number) 3e3))) - (json-tests--with-temp-buffer "1e-7" - (should (= (json-read-number) 1e-7))) - (json-tests--with-temp-buffer "abc" - (should-error (json-read-number) :type 'json-number-format))) +(ert-deftest test-json-read-integer () + (json-tests--with-temp-buffer "0 " + (should (= (json-read-number) 0)) + (should (eobp))) + (json-tests--with-temp-buffer "-0 " + (should (= (json-read-number) 0)) + (should (eobp))) + (json-tests--with-temp-buffer "3 " + (should (= (json-read-number) 3)) + (should (eobp))) + (json-tests--with-temp-buffer "-10 " + (should (= (json-read-number) -10)) + (should (eobp))) + (json-tests--with-temp-buffer (format "%d " (1+ most-positive-fixnum)) + (should (= (json-read-number) (1+ most-positive-fixnum))) + (should (eobp))) + (json-tests--with-temp-buffer (format "%d " (1- most-negative-fixnum)) + (should (= (json-read-number) (1- most-negative-fixnum))) + (should (eobp)))) + +(ert-deftest test-json-read-fraction () + (json-tests--with-temp-buffer "0.0 " + (should (= (json-read-number) 0.0)) + (should (eobp))) + (json-tests--with-temp-buffer "-0.0 " + (should (= (json-read-number) 0.0)) + (should (eobp))) + (json-tests--with-temp-buffer "0.01 " + (should (= (json-read-number) 0.01)) + (should (eobp))) + (json-tests--with-temp-buffer "-0.01 " + (should (= (json-read-number) -0.01)) + (should (eobp))) + (json-tests--with-temp-buffer "123.456 " + (should (= (json-read-number) 123.456)) + (should (eobp))) + (json-tests--with-temp-buffer "-123.456 " + (should (= (json-read-number) -123.456)) + (should (eobp)))) + +(ert-deftest test-json-read-exponent () + (json-tests--with-temp-buffer "0e0 " + (should (= (json-read-number) 0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "-0E0 " + (should (= (json-read-number) 0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "-0E+0 " + (should (= (json-read-number) 0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "0e-0 " + (should (= (json-read-number) 0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "12e34 " + (should (= (json-read-number) 12e34)) + (should (eobp))) + (json-tests--with-temp-buffer "-12E34 " + (should (= (json-read-number) -12e34)) + (should (eobp))) + (json-tests--with-temp-buffer "-12E+34 " + (should (= (json-read-number) -12e34)) + (should (eobp))) + (json-tests--with-temp-buffer "12e-34 " + (should (= (json-read-number) 12e-34)) + (should (eobp)))) + +(ert-deftest test-json-read-fraction-exponent () + (json-tests--with-temp-buffer "0.0e0 " + (should (= (json-read-number) 0.0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "-0.0E0 " + (should (= (json-read-number) 0.0e0)) + (should (eobp))) + (json-tests--with-temp-buffer "0.12E-0 " + (should (= (json-read-number) 0.12e0)) + (should (eobp))) + (json-tests--with-temp-buffer "-12.34e+56 " + (should (= (json-read-number) -12.34e+56)) + (should (eobp)))) + +(ert-deftest test-json-read-number-invalid () + (cl-flet ((read (str) + ;; Return error and point resulting from reading STR. + (json-tests--with-temp-buffer str + (cons (should-error (json-read-number)) (point))))) + ;; POS is where each of its STRINGS becomes invalid. + (pcase-dolist (`(,pos . ,strings) + '((1 "" "+" "-" "." "e" "e1" "abc" "++0" "++1" + "+0" "+0.0" "+12" "+12.34" "+12.34e56" + ".0" "+.0" "-.0" ".12" "+.12" "-.12" + ".e0" "+.e0" "-.e0" ".0e0" "+.0e0" "-.0e0") + (2 "01" "1ee1" "1e++1") + (3 "-01") + (4 "0.0.0" "1.1.1" "1e1e1") + (5 "-0.0.0" "-1.1.1"))) + ;; Expected error and point. + (let ((res `((json-number-format ,pos) . ,pos))) + (dolist (str strings) + (should (equal (read str) res))))))) (ert-deftest test-json-encode-number () + (should (equal (json-encode-number 0) "0")) + (should (equal (json-encode-number -0) "0")) (should (equal (json-encode-number 3) "3")) (should (equal (json-encode-number -5) "-5")) - (should (equal (json-encode-number 123.456) "123.456"))) + (should (equal (json-encode-number 123.456) "123.456")) + (let ((bignum (1+ most-positive-fixnum))) + (should (equal (json-encode-number bignum) + (number-to-string bignum))))) -;; Strings +;;; Strings (ert-deftest test-json-read-escaped-char () (json-tests--with-temp-buffer "\\\"" - (should (equal (json-read-escaped-char) ?\")))) + (should (= (json-read-escaped-char) ?\")) + (should (eobp))) + (json-tests--with-temp-buffer "\\\\ " + (should (= (json-read-escaped-char) ?\\)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\b " + (should (= (json-read-escaped-char) ?\b)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\f " + (should (= (json-read-escaped-char) ?\f)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\n " + (should (= (json-read-escaped-char) ?\n)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\r " + (should (= (json-read-escaped-char) ?\r)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\t " + (should (= (json-read-escaped-char) ?\t)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\x " + (should (= (json-read-escaped-char) ?x)) + (should (= (point) (+ (point-min) 2)))) + (json-tests--with-temp-buffer "\\ud800\\uDC00 " + (should (= (json-read-escaped-char) #x10000)) + (should (= (point) (+ (point-min) 12)))) + (json-tests--with-temp-buffer "\\ud7ff\\udc00 " + (should (= (json-read-escaped-char) #xd7ff)) + (should (= (point) (+ (point-min) 6)))) + (json-tests--with-temp-buffer "\\uffff " + (should (= (json-read-escaped-char) #xffff)) + (should (= (point) (+ (point-min) 6)))) + (json-tests--with-temp-buffer "\\ufffff " + (should (= (json-read-escaped-char) #xffff)) + (should (= (point) (+ (point-min) 6))))) + +(ert-deftest test-json-read-escaped-char-invalid () + (json-tests--with-temp-buffer "" + (should-error (json-read-escaped-char))) + (json-tests--with-temp-buffer "\\" + (should-error (json-read-escaped-char) :type 'json-end-of-file)) + (json-tests--with-temp-buffer "\\ufff " + (should (equal (should-error (json-read-escaped-char)) + (list 'json-string-escape (+ (point-min) 2))))) + (json-tests--with-temp-buffer "\\ufffg " + (should (equal (should-error (json-read-escaped-char)) + (list 'json-string-escape (+ (point-min) 2)))))) (ert-deftest test-json-read-string () + (json-tests--with-temp-buffer "" + (should-error (json-read-string))) (json-tests--with-temp-buffer "\"formfeed\f\"" - (should-error (json-read-string) :type 'json-string-format)) + (should (equal (should-error (json-read-string)) + '(json-string-format ?\f)))) + (json-tests--with-temp-buffer "\"\"" + (should (equal (json-read-string) ""))) (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\"" (should (equal (json-read-string) "foo \"bar\""))) (json-tests--with-temp-buffer "\"abcαβγ\"" @@ -175,57 +405,117 @@ Point is moved to beginning of the buffer." ;; Bug#24784 (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" (should (equal (json-read-string) "\U0001D11E"))) + (json-tests--with-temp-buffer "f" + (should-error (json-read-string) :type 'json-end-of-file)) (json-tests--with-temp-buffer "foo" - (should-error (json-read-string) :type 'json-string-format))) + (should-error (json-read-string) :type 'json-end-of-file))) (ert-deftest test-json-encode-string () + (should (equal (json-encode-string "") "\"\"")) + (should (equal (json-encode-string "a") "\"a\"")) (should (equal (json-encode-string "foo") "\"foo\"")) (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) (ert-deftest test-json-encode-key () + (should (equal (json-encode-key "") "\"\"")) + (should (equal (json-encode-key '##) "\"\"")) + (should (equal (json-encode-key :) "\"\"")) (should (equal (json-encode-key "foo") "\"foo\"")) (should (equal (json-encode-key 'foo) "\"foo\"")) (should (equal (json-encode-key :foo) "\"foo\"")) - (should-error (json-encode-key 5) :type 'json-key-format) - (should-error (json-encode-key ["foo"]) :type 'json-key-format) - (should-error (json-encode-key '("foo")) :type 'json-key-format)) + (should (equal (should-error (json-encode-key 5)) + '(json-key-format 5))) + (should (equal (should-error (json-encode-key ["foo"])) + '(json-key-format ["foo"]))) + (should (equal (should-error (json-encode-key '("foo"))) + '(json-key-format ("foo"))))) ;;; Objects (ert-deftest test-json-new-object () (let ((json-object-type 'alist)) - (should (equal (json-new-object) '()))) + (should-not (json-new-object))) (let ((json-object-type 'plist)) - (should (equal (json-new-object) '()))) + (should-not (json-new-object))) (let* ((json-object-type 'hash-table) (json-object (json-new-object))) (should (hash-table-p json-object)) - (should (= (hash-table-count json-object) 0)))) + (should (map-empty-p json-object)) + (should (eq (hash-table-test json-object) #'equal)))) -(ert-deftest test-json-add-to-object () +(ert-deftest test-json-add-to-alist () (let* ((json-object-type 'alist) - (json-key-type nil) (obj (json-new-object))) - (setq obj (json-add-to-object obj "a" 1)) - (setq obj (json-add-to-object obj "b" 2)) - (should (equal (assq 'a obj) '(a . 1))) - (should (equal (assq 'b obj) '(b . 2)))) + (let ((json-key-type nil)) + (setq obj (json-add-to-object obj "a" 1)) + (setq obj (json-add-to-object obj "b" 2)) + (should (equal (assq 'a obj) '(a . 1))) + (should (equal (assq 'b obj) '(b . 2)))) + (let ((json-key-type 'symbol)) + (setq obj (json-add-to-object obj "c" 3)) + (setq obj (json-add-to-object obj "d" 4)) + (should (equal (assq 'c obj) '(c . 3))) + (should (equal (assq 'd obj) '(d . 4)))) + (let ((json-key-type 'keyword)) + (setq obj (json-add-to-object obj "e" 5)) + (setq obj (json-add-to-object obj "f" 6)) + (should (equal (assq :e obj) '(:e . 5))) + (should (equal (assq :f obj) '(:f . 6)))) + (let ((json-key-type 'string)) + (setq obj (json-add-to-object obj "g" 7)) + (setq obj (json-add-to-object obj "h" 8)) + (should (equal (assoc "g" obj) '("g" . 7))) + (should (equal (assoc "h" obj) '("h" . 8)))))) + +(ert-deftest test-json-add-to-plist () (let* ((json-object-type 'plist) - (json-key-type nil) (obj (json-new-object))) - (setq obj (json-add-to-object obj "a" 1)) - (setq obj (json-add-to-object obj "b" 2)) - (should (= (plist-get obj :a) 1)) - (should (= (plist-get obj :b) 2))) + (let ((json-key-type nil)) + (setq obj (json-add-to-object obj "a" 1)) + (setq obj (json-add-to-object obj "b" 2)) + (should (= (plist-get obj :a) 1)) + (should (= (plist-get obj :b) 2))) + (let ((json-key-type 'keyword)) + (setq obj (json-add-to-object obj "c" 3)) + (setq obj (json-add-to-object obj "d" 4)) + (should (= (plist-get obj :c) 3)) + (should (= (plist-get obj :d) 4))) + (let ((json-key-type 'symbol)) + (setq obj (json-add-to-object obj "e" 5)) + (setq obj (json-add-to-object obj "f" 6)) + (should (= (plist-get obj 'e) 5)) + (should (= (plist-get obj 'f) 6))) + (let ((json-key-type 'string)) + (setq obj (json-add-to-object obj "g" 7)) + (setq obj (json-add-to-object obj "h" 8)) + (should (= (lax-plist-get obj "g") 7)) + (should (= (lax-plist-get obj "h") 8))))) + +(ert-deftest test-json-add-to-hash-table () (let* ((json-object-type 'hash-table) - (json-key-type nil) (obj (json-new-object))) - (setq obj (json-add-to-object obj "a" 1)) - (setq obj (json-add-to-object obj "b" 2)) - (should (= (gethash "a" obj) 1)) - (should (= (gethash "b" obj) 2)))) + (let ((json-key-type nil)) + (setq obj (json-add-to-object obj "a" 1)) + (setq obj (json-add-to-object obj "b" 2)) + (should (= (gethash "a" obj) 1)) + (should (= (gethash "b" obj) 2))) + (let ((json-key-type 'string)) + (setq obj (json-add-to-object obj "c" 3)) + (setq obj (json-add-to-object obj "d" 4)) + (should (= (gethash "c" obj) 3)) + (should (= (gethash "d" obj) 4))) + (let ((json-key-type 'symbol)) + (setq obj (json-add-to-object obj "e" 5)) + (setq obj (json-add-to-object obj "f" 6)) + (should (= (gethash 'e obj) 5)) + (should (= (gethash 'f obj) 6))) + (let ((json-key-type 'keyword)) + (setq obj (json-add-to-object obj "g" 7)) + (setq obj (json-add-to-object obj "h" 8)) + (should (= (gethash :g obj) 7)) + (should (= (gethash :h obj) 8))))) (ert-deftest test-json-read-object () (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" @@ -238,94 +528,384 @@ Point is moved to beginning of the buffer." (let* ((json-object-type 'hash-table) (hash-table (json-read-object))) (should (= (gethash "a" hash-table) 1)) - (should (= (gethash "b" hash-table) 2)))) + (should (= (gethash "b" hash-table) 2))))) + +(ert-deftest test-json-read-object-empty () + (json-tests--with-temp-buffer "{}" + (let ((json-object-type 'alist)) + (should-not (save-excursion (json-read-object)))) + (let ((json-object-type 'plist)) + (should-not (save-excursion (json-read-object)))) + (let* ((json-object-type 'hash-table) + (hash-table (json-read-object))) + (should (hash-table-p hash-table)) + (should (map-empty-p hash-table))))) + +(ert-deftest test-json-read-object-invalid () + (json-tests--with-temp-buffer "{ \"a\" 1, \"b\": 2 }" + (should (equal (should-error (json-read-object)) + '(json-object-format ":" ?1)))) (json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }" - (should-error (json-read-object) :type 'json-object-format))) + (should (equal (should-error (json-read-object)) + '(json-object-format "," ?\"))))) + +(ert-deftest test-json-read-object-function () + (let* ((pre nil) + (post nil) + (keys '("b" "a")) + (json-pre-element-read-function + (lambda (key) + (setq pre 'pre) + (should (equal key (pop keys))))) + (json-post-element-read-function + (lambda () (setq post 'post)))) + (json-tests--with-temp-buffer "{ \"b\": 2, \"a\": 1 }" + (json-read-object) + (should (eq pre 'pre)) + (should (eq post 'post))))) (ert-deftest test-json-encode-hash-table () - (let ((hash-table (make-hash-table)) - (json-encoding-object-sort-predicate 'string<) + (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) - (puthash :a 1 hash-table) - (puthash :b 2 hash-table) - (puthash :c 3 hash-table) - (should (equal (json-encode hash-table) - "{\"a\":1,\"b\":2,\"c\":3}")))) - -(ert-deftest json-encode-simple-alist () - (let ((json-encoding-pretty-print nil)) - (should (equal (json-encode '((a . 1) (b . 2))) - "{\"a\":1,\"b\":2}")))) - -(ert-deftest test-json-encode-plist () - (let ((plist '(:a 1 :b 2)) + (should (equal (json-encode-hash-table #s(hash-table)) "{}")) + (should (equal (json-encode-hash-table #s(hash-table data (a 1))) + "{\"a\":1}")) + (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) + '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) + (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) + '("{\"a\":1,\"b\":2,\"c\":3}" + "{\"a\":1,\"c\":3,\"b\":2}" + "{\"b\":2,\"a\":1,\"c\":3}" + "{\"b\":2,\"c\":3,\"a\":1}" + "{\"c\":3,\"a\":1,\"b\":2}" + "{\"c\":3,\"b\":2,\"a\":1}"))))) + +(ert-deftest test-json-encode-hash-table-pretty () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings nil)) + (should (equal (json-encode-hash-table #s(hash-table)) "{}")) + (should (equal (json-encode-hash-table #s(hash-table data (a 1))) + "{\n \"a\": 1\n}")) + (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) + '("{\n \"a\": 1,\n \"b\": 2\n}" + "{\n \"b\": 2,\n \"a\": 1\n}"))) + (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) + '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}" + "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}" + "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}" + "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1\n}" + "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2\n}" + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))) + +(ert-deftest test-json-encode-hash-table-lisp-style () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings t)) + (should (equal (json-encode-hash-table #s(hash-table)) "{}")) + (should (equal (json-encode-hash-table #s(hash-table data (a 1))) + "{\n \"a\": 1}")) + (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) + '("{\n \"a\": 1,\n \"b\": 2}" + "{\n \"b\": 2,\n \"a\": 1}"))) + (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) + '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}" + "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}" + "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}" + "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1}" + "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2}" + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))) + +(ert-deftest test-json-encode-hash-table-sort () + (let ((json-encoding-object-sort-predicate #'string<) (json-encoding-pretty-print nil)) - (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) - -(ert-deftest test-json-encode-plist-with-sort-predicate () - (let ((plist '(:c 3 :a 1 :b 2)) - (json-encoding-object-sort-predicate 'string<) + (pcase-dolist (`(,in . ,out) + '((#s(hash-table) . "{}") + (#s(hash-table data (a 1)) . "{\"a\":1}") + (#s(hash-table data (b 2 a 1)) . "{\"a\":1,\"b\":2}") + (#s(hash-table data (c 3 b 2 a 1)) + . "{\"a\":1,\"b\":2,\"c\":3}"))) + (let ((copy (map-pairs in))) + (should (equal (json-encode-hash-table in) out)) + ;; Ensure sorting isn't destructive. + (should (seq-set-equal-p (map-pairs in) copy)))))) + +(ert-deftest test-json-encode-alist () + (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) - (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) + (should (equal (json-encode-alist ()) "{}")) + (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) + "{\"c\":3,\"b\":2,\"a\":1}")))) + +(ert-deftest test-json-encode-alist-pretty () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings nil)) + (should (equal (json-encode-alist ()) "{}")) + (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1\n}")) + (should (equal (json-encode-alist '((b . 2) (a . 1))) + "{\n \"b\": 2,\n \"a\": 1\n}")) + (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))) + +(ert-deftest test-json-encode-alist-lisp-style () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings t)) + (should (equal (json-encode-alist ()) "{}")) + (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1}")) + (should (equal (json-encode-alist '((b . 2) (a . 1))) + "{\n \"b\": 2,\n \"a\": 1}")) + (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))) + +(ert-deftest test-json-encode-alist-sort () + (let ((json-encoding-object-sort-predicate #'string<) + (json-encoding-pretty-print nil)) + (pcase-dolist (`(,in . ,out) + '((() . "{}") + (((a . 1)) . "{\"a\":1}") + (((b . 2) (a . 1)) . "{\"a\":1,\"b\":2}") + (((c . 3) (b . 2) (a . 1)) + . "{\"a\":1,\"b\":2,\"c\":3}"))) + (let ((copy (copy-alist in))) + (should (equal (json-encode-alist in) out)) + ;; Ensure sorting isn't destructive (bug#40693). + (should (equal in copy)))))) -(ert-deftest test-json-encode-alist-with-sort-predicate () - (let ((alist '((:c . 3) (:a . 1) (:b . 2))) - (json-encoding-object-sort-predicate 'string<) +(ert-deftest test-json-encode-plist () + (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) - (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) + (should (equal (json-encode-plist ()) "{}")) + (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}")) + (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) + "{\"c\":3,\"b\":2,\"a\":1}")))) + +(ert-deftest test-json-encode-plist-pretty () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings nil)) + (should (equal (json-encode-plist ()) "{}")) + (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1\n}")) + (should (equal (json-encode-plist '(:b 2 :a 1)) + "{\n \"b\": 2,\n \"a\": 1\n}")) + (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))) + +(ert-deftest test-json-encode-plist-lisp-style () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings t)) + (should (equal (json-encode-plist ()) "{}")) + (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1}")) + (should (equal (json-encode-plist '(:b 2 :a 1)) + "{\n \"b\": 2,\n \"a\": 1}")) + (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) + "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))) + +(ert-deftest test-json-encode-plist-sort () + (let ((json-encoding-object-sort-predicate #'string<) + (json-encoding-pretty-print nil)) + (pcase-dolist (`(,in . ,out) + '((() . "{}") + ((:a 1) . "{\"a\":1}") + ((:b 2 :a 1) . "{\"a\":1,\"b\":2}") + ((:c 3 :b 2 :a 1) . "{\"a\":1,\"b\":2,\"c\":3}"))) + (let ((copy (copy-sequence in))) + (should (equal (json-encode-plist in) out)) + ;; Ensure sorting isn't destructive. + (should (equal in copy)))))) (ert-deftest test-json-encode-list () - (let ((json-encoding-pretty-print nil)) - (should (equal (json-encode-list '(:a 1 :b 2)) - "{\"a\":1,\"b\":2}")) - (should (equal (json-encode-list '((:a . 1) (:b . 2))) - "{\"a\":1,\"b\":2}")) - (should (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]")))) + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print nil)) + (should (equal (json-encode-list ()) "{}")) + (should (equal (json-encode-list '(a)) "[\"a\"]")) + (should (equal (json-encode-list '(:a)) "[\"a\"]")) + (should (equal (json-encode-list '("a")) "[\"a\"]")) + (should (equal (json-encode-list '(a 1)) "[\"a\",1]")) + (should (equal (json-encode-list '("a" 1)) "[\"a\",1]")) + (should (equal (json-encode-list '(:a 1)) "{\"a\":1}")) + (should (equal (json-encode-list '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}")) + (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]")) + (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]")) + (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]")) + (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode-list '((:b . 2) (:a . 1))) + "{\"b\":2,\"a\":1}")) + (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]")) + (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]")) + (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]")) + (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]")) + (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]")) + (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]")) + (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) + (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) + (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument) + (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument) + (should (equal (should-error (json-encode-list [])) + '(json-error []))) + (should (equal (should-error (json-encode-list [a])) + '(json-error [a]))))) ;;; Arrays (ert-deftest test-json-read-array () (let ((json-array-type 'vector)) + (json-tests--with-temp-buffer "[]" + (should (equal (json-read-array) []))) + (json-tests--with-temp-buffer "[ ]" + (should (equal (json-read-array) []))) + (json-tests--with-temp-buffer "[1]" + (should (equal (json-read-array) [1]))) (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" (should (equal (json-read-array) [1 2 "a" "b"])))) (let ((json-array-type 'list)) + (json-tests--with-temp-buffer "[]" + (should-not (json-read-array))) + (json-tests--with-temp-buffer "[ ]" + (should-not (json-read-array))) + (json-tests--with-temp-buffer "[1]" + (should (equal (json-read-array) '(1)))) (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" (should (equal (json-read-array) '(1 2 "a" "b"))))) (json-tests--with-temp-buffer "[1 2]" - (should-error (json-read-array) :type 'json-error))) + (should (equal (should-error (json-read-array)) + '(json-array-format "," ?2))))) + +(ert-deftest test-json-read-array-function () + (let* ((pre nil) + (post nil) + (keys '(0 1)) + (json-pre-element-read-function + (lambda (key) + (setq pre 'pre) + (should (equal key (pop keys))))) + (json-post-element-read-function + (lambda () (setq post 'post)))) + (json-tests--with-temp-buffer "[1, 0]" + (json-read-array) + (should (eq pre 'pre)) + (should (eq post 'post))))) (ert-deftest test-json-encode-array () - (let ((json-encoding-pretty-print nil)) - (should (equal (json-encode-array [1 2 "a" "b"]) - "[1,2,\"a\",\"b\"]")))) + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print nil)) + (should (equal (json-encode-array ()) "[]")) + (should (equal (json-encode-array []) "[]")) + (should (equal (json-encode-array '(1)) "[1]")) + (should (equal (json-encode-array '[1]) "[1]")) + (should (equal (json-encode-array '(2 1)) "[2,1]")) + (should (equal (json-encode-array '[2 1]) "[2,1]")) + (should (equal (json-encode-array '[:b a 2 1]) "[\"b\",\"a\",2,1]")))) + +(ert-deftest test-json-encode-array-pretty () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings nil)) + (should (equal (json-encode-array ()) "[]")) + (should (equal (json-encode-array []) "[]")) + (should (equal (json-encode-array '(1)) "[\n 1\n]")) + (should (equal (json-encode-array '[1]) "[\n 1\n]")) + (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1\n]")) + (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1\n]")) + (should (equal (json-encode-array '[:b a 2 1]) + "[\n \"b\",\n \"a\",\n 2,\n 1\n]")))) + +(ert-deftest test-json-encode-array-lisp-style () + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print t) + (json-encoding-default-indentation " ") + (json-encoding-lisp-style-closings t)) + (should (equal (json-encode-array ()) "[]")) + (should (equal (json-encode-array []) "[]")) + (should (equal (json-encode-array '(1)) "[\n 1]")) + (should (equal (json-encode-array '[1]) "[\n 1]")) + (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1]")) + (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1]")) + (should (equal (json-encode-array '[:b a 2 1]) + "[\n \"b\",\n \"a\",\n 2,\n 1]")))) ;;; Reader (ert-deftest test-json-read () - (json-tests--with-temp-buffer "{ \"a\": 1 }" - ;; We don't care exactly what the return value is (that is tested - ;; in `test-json-read-object'), but it should parse without error. - (should (json-read))) + (pcase-dolist (`(,fn . ,contents) + '((json-read-string "\"\"" "\"a\"") + (json-read-array "[]" "[1]") + (json-read-object "{}" "{\"a\":1}") + (json-read-keyword "null" "false" "true") + (json-read-number + "-0" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) + (dolist (content contents) + ;; Check that leading whitespace is skipped. + (dolist (str (list content (concat " " content))) + (cl-letf* ((called nil) + ((symbol-function fn) + (lambda (&rest _) (setq called t)))) + (json-tests--with-temp-buffer str + ;; We don't care exactly what the return value is (that is + ;; tested elsewhere), but it should parse without error. + (should (json-read)) + (should called))))))) + +(ert-deftest test-json-read-invalid () (json-tests--with-temp-buffer "" (should-error (json-read) :type 'json-end-of-file)) - (json-tests--with-temp-buffer "xxx" - (let ((err (should-error (json-read) :type 'json-readtable-error))) - (should (equal (cdr err) '(?x)))))) + (json-tests--with-temp-buffer " " + (should-error (json-read) :type 'json-end-of-file)) + (json-tests--with-temp-buffer "x" + (should (equal (should-error (json-read)) + '(json-readtable-error ?x)))) + (json-tests--with-temp-buffer " x" + (should (equal (should-error (json-read)) + '(json-readtable-error ?x))))) (ert-deftest test-json-read-from-string () - (let ((json-string "{ \"a\": 1 }")) - (json-tests--with-temp-buffer json-string - (should (equal (json-read-from-string json-string) + (dolist (str '("\"\"" "\"a\"" "[]" "[1]" "{}" "{\"a\":1}" + "null" "false" "true" "0" "123")) + (json-tests--with-temp-buffer str + (should (equal (json-read-from-string str) (json-read)))))) -;;; JSON encoder +;;; Encoder (ert-deftest test-json-encode () + (should (equal (json-encode t) "true")) + (let ((json-null 'null)) + (should (equal (json-encode json-null) "null"))) + (let ((json-false 'false)) + (should (equal (json-encode json-false) "false"))) + (should (equal (json-encode "") "\"\"")) (should (equal (json-encode "foo") "\"foo\"")) + (should (equal (json-encode :) "\"\"")) + (should (equal (json-encode :foo) "\"foo\"")) + (should (equal (json-encode '(1)) "[1]")) + (should (equal (json-encode 'foo) "\"foo\"")) + (should (equal (json-encode 0) "0")) + (should (equal (json-encode 123) "123")) + (let ((json-encoding-object-sort-predicate nil) + (json-encoding-pretty-print nil)) + (should (equal (json-encode []) "[]")) + (should (equal (json-encode [1]) "[1]")) + (should (equal (json-encode #s(hash-table)) "{}")) + (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}"))) (with-temp-buffer - (should-error (json-encode (current-buffer)) :type 'json-error))) + (should (equal (should-error (json-encode (current-buffer))) + (list 'json-error (current-buffer)))))) -;;; Pretty-print +;;; Pretty printing & minimizing (defun json-tests-equal-pretty-print (original &optional expected) "Abort current test if pretty-printing ORIGINAL does not yield EXPECTED. @@ -351,46 +931,45 @@ nil, ORIGINAL should stay unchanged by pretty-printing." (json-tests-equal-pretty-print "0.123")) (ert-deftest test-json-pretty-print-object () - ;; empty (regression test for bug#24252) - (json-tests-equal-pretty-print - "{}" - "{\n}") - ;; one pair + ;; Empty (regression test for bug#24252). + (json-tests-equal-pretty-print "{}") + ;; One pair. (json-tests-equal-pretty-print "{\"key\":1}" "{\n \"key\": 1\n}") - ;; two pairs + ;; Two pairs. (json-tests-equal-pretty-print "{\"key1\":1,\"key2\":2}" "{\n \"key1\": 1,\n \"key2\": 2\n}") - ;; embedded object + ;; Nested object. (json-tests-equal-pretty-print "{\"foo\":{\"key\":1}}" "{\n \"foo\": {\n \"key\": 1\n }\n}") - ;; embedded array + ;; Nested array. (json-tests-equal-pretty-print "{\"key\":[1,2]}" "{\n \"key\": [\n 1,\n 2\n ]\n}")) (ert-deftest test-json-pretty-print-array () - ;; empty + ;; Empty. (json-tests-equal-pretty-print "[]") - ;; one item + ;; One item. (json-tests-equal-pretty-print "[1]" "[\n 1\n]") - ;; two items + ;; Two items. (json-tests-equal-pretty-print "[1,2]" "[\n 1,\n 2\n]") - ;; embedded object + ;; Nested object. (json-tests-equal-pretty-print "[{\"key\":1}]" "[\n {\n \"key\": 1\n }\n]") - ;; embedded array + ;; Nested array. (json-tests-equal-pretty-print "[[1,2]]" "[\n [\n 1,\n 2\n ]\n]")) (provide 'json-tests) + ;;; json-tests.el ends here |