fix: Handle surrogate pairs in JSON unicode escapes

Message

The JSON decoder now correctly handles UTF-16 surrogate pairs (uD83DuDE00 → U+1F600) for emoji and supplementary plane characters. Bare low surrogates are rejected per RFC 8259.

Changed

 src/sigil/json.sgl | 33 ++++++++++++++++++++++++++-------
 test/test-json.sgl | 14 +++++++++++++-
 2 files changed, 39 insertions(+), 8 deletions(-)

Diff

src/sigil/json.sglmodified

@@ -461,19 +461,38 @@

461

(else

462

(loop (cons c chars)))))))

463

−464

;; Read a \uXXXX unicode escape

−465

(define (json-read-unicode-escape port)

+464

;; Read 4 hex digits from port and return as integer, or #f on error.

+465

(define (read-hex4 port)

466

(let* ((h1 (read-char port))

467

(h2 (read-char port))

468

(h3 (read-char port))

469

(h4 (read-char port)))

470

(if (or (eof-object? h1) (eof-object? h2)

471

(eof-object? h3) (eof-object? h4))

−472

(error "Invalid unicode escape")

−473

(let ((n (string->number (list->string (list h1 h2 h3 h4)) 16)))

−474

(if n

−475

(integer->char n)

−476

(error "Invalid unicode escape"))))))

+472

#f

+473

(string->number (list->string (list h1 h2 h3 h4)) 16))))

+474

+475

;; Read a \uXXXX unicode escape, handling surrogate pairs.

+476

(define (json-read-unicode-escape port)

+477

(let ((n (read-hex4 port)))

+478

(cond

+479

((not n) (error "Invalid unicode escape"))

+480

;; High surrogate: must be followed by \uXXXX low surrogate

+481

((and (>= n #xD800) (<= n #xDBFF))

+482

(let ((bs (read-char port))

+483

(u (read-char port)))

+484

(if (and (eqv? bs #\\) (eqv? u #\u))

+485

(let ((low (read-hex4 port)))

+486

(if (and low (>= low #xDC00) (<= low #xDFFF))

+487

(integer->char (+ #x10000

+488

(* (- n #xD800) #x400)

+489

(- low #xDC00)))

+490

(error "Invalid surrogate pair")))

+491

(error "Expected low surrogate after high surrogate"))))

+492

;; Bare low surrogate is invalid

+493

((and (>= n #xDC00) (<= n #xDFFF))

+494

(error "Unexpected low surrogate"))

+495

(else (integer->char n)))))

496

497

;; Read a JSON number

498

(define (json-read-number port)

test/test-json.sglmodified

@@ -109,7 +109,19 @@

109

(assert-equal "a\tb" (json-decode "\"a\\tb\"")))

110

111

(test "decode unicode escape"

−112

(assert-equal "A" (json-decode "\"\\u0041\""))))

+112

(assert-equal "A" (json-decode "\"\\u0041\"")))

+113

+114

(test "decode surrogate pair (emoji)"

+115

(assert-equal "\x1F600;" (json-decode "\"\\uD83D\\uDE00\"")))

+116

+117

(test "decode surrogate pair (musical symbol)"

+118

(assert-equal "\x1D11E;" (json-decode "\"\\uD834\\uDD1E\"")))

+119

+120

(test "reject bare low surrogate"

+121

(assert-true

+122

(guard (exn (else #t))

+123

(json-decode "\"\\uDE00\"")

+124

#f))))

125

126

(test-group "json-null?"

127

(test "null symbol is null"