aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/json.el15
-rw-r--r--test/lisp/json-tests.el3
2 files changed, 18 insertions, 0 deletions
diff --git a/lisp/json.el b/lisp/json.el
index 38f828e8fbb..b2ac356641b 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -363,6 +363,10 @@ representation will be parsed correctly."
363 363
364;; String parsing 364;; String parsing
365 365
366(defun json--decode-utf-16-surrogates (high low)
367 "Return the code point represented by the UTF-16 surrogates HIGH and LOW."
368 (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000))
369
366(defun json-read-escaped-char () 370(defun json-read-escaped-char ()
367 "Read the JSON string escaped character at point." 371 "Read the JSON string escaped character at point."
368 ;; Skip over the '\' 372 ;; Skip over the '\'
@@ -372,6 +376,17 @@ representation will be parsed correctly."
372 (cond 376 (cond
373 (special (cdr special)) 377 (special (cdr special))
374 ((not (eq char ?u)) char) 378 ((not (eq char ?u)) char)
379 ;; Special-case UTF-16 surrogate pairs,
380 ;; cf. https://tools.ietf.org/html/rfc7159#section-7. Note that
381 ;; this clause overlaps with the next one and therefore has to
382 ;; come first.
383 ((looking-at
384 (rx (group (any "Dd") (any "89ABab") (= 2 (any "0-9A-Fa-f")))
385 "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any "0-9A-Fa-f")))))
386 (json-advance 10)
387 (json--decode-utf-16-surrogates
388 (string-to-number (match-string 1) 16)
389 (string-to-number (match-string 2) 16)))
375 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]") 390 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
376 (let ((hex (match-string 0))) 391 (let ((hex (match-string 0)))
377 (json-advance 4) 392 (json-advance 4)
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 66fc25ad1c0..38672de0664 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -167,6 +167,9 @@ Point is moved to beginning of the buffer."
167 (should (equal (json-read-string) "abcαβγ"))) 167 (should (equal (json-read-string) "abcαβγ")))
168 (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" 168 (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\""
169 (should (equal (json-read-string) "\nasdфывfgh\t"))) 169 (should (equal (json-read-string) "\nasdфывfgh\t")))
170 ;; Bug#24784
171 (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
172 (should (equal (json-read-string) "\U0001D11E")))
170 (json-tests--with-temp-buffer "foo" 173 (json-tests--with-temp-buffer "foo"
171 (should-error (json-read-string) :type 'json-string-format))) 174 (should-error (json-read-string) :type 'json-string-format)))
172 175