diff options
| -rw-r--r-- | lisp/json.el | 15 | ||||
| -rw-r--r-- | test/lisp/json-tests.el | 3 |
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 | ||