Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
This commit is contained in:
Eli Zaretskii
commit
601e772b06
14 changed files with 329 additions and 229 deletions
15
etc/NEWS
15
etc/NEWS
|
|
@ -1218,6 +1218,12 @@ instead of:
|
|||
This allows the user to specify command line arguments to the non
|
||||
interactive Python interpreter specified by 'python-interpreter'.
|
||||
|
||||
** Scheme mode
|
||||
|
||||
Scheme mode now handles regular expression literal #/regexp/ that is
|
||||
available in some Scheme implementations.
|
||||
Also, it should now handle nested sexp-comments.
|
||||
|
||||
** use-package
|
||||
|
||||
+++
|
||||
|
|
@ -1715,6 +1721,11 @@ Use a float value for the first argument instead.
|
|||
Instead, use 'eshell-process-wait-time', which supports floating-point
|
||||
values.
|
||||
|
||||
---
|
||||
** The JSON parser sometimes signals different types of errors.
|
||||
It will now signal 'json-utf8-decode-error' for inputs that are not
|
||||
correctly UTF-8 encoded.
|
||||
|
||||
|
||||
* Lisp Changes in Emacs 30.1
|
||||
|
||||
|
|
@ -2315,6 +2326,10 @@ this case, would mean repeating the object in the argument list.) When
|
|||
replacing an object with a different one, passing both the new and old
|
||||
objects is still necessary.
|
||||
|
||||
---
|
||||
** The JSON encoder and decoder now accept arbitarily large integers.
|
||||
Previously, they were limited to the range of signed 64-bit integers.
|
||||
|
||||
|
||||
* Changes in Emacs 30.1 on Non-Free Operating Systems
|
||||
|
||||
|
|
|
|||
|
|
@ -3402,8 +3402,8 @@ lambda-expression."
|
|||
(t "."))))
|
||||
(let ((mutargs (function-get (car form) 'mutates-arguments)))
|
||||
(when mutargs
|
||||
(dolist (idx (if (eq mutargs 'all-but-last)
|
||||
(number-sequence 1 (- (length form) 2))
|
||||
(dolist (idx (if (symbolp mutargs)
|
||||
(funcall mutargs form)
|
||||
mutargs))
|
||||
(let ((arg (nth idx form)))
|
||||
(when (and (or (and (eq (car-safe arg) 'quote)
|
||||
|
|
@ -3472,13 +3472,15 @@ lambda-expression."
|
|||
(if byte-compile--for-effect
|
||||
(byte-compile-discard)))))
|
||||
|
||||
(defun bytecomp--sort-call-in-place-p (form)
|
||||
(or (= (length form) 3) ; old-style
|
||||
(plist-get (cddr form) :in-place))) ; new-style
|
||||
|
||||
(defun bytecomp--actually-important-return-value-p (form)
|
||||
"Whether FORM is really a call with a return value that should not go unused.
|
||||
This assumes the function has the `important-return-value' property."
|
||||
(cond ((eq (car form) 'sort)
|
||||
;; For `sort', we only care about non-destructive uses.
|
||||
(and (zerop (% (length form) 2)) ; new-style call
|
||||
(not (plist-get (cddr form) :in-place))))
|
||||
(not (bytecomp--sort-call-in-place-p form)))
|
||||
(t t)))
|
||||
|
||||
(let ((important-return-value-fns
|
||||
|
|
@ -3504,18 +3506,27 @@ This assumes the function has the `important-return-value' property."
|
|||
(dolist (fn important-return-value-fns)
|
||||
(put fn 'important-return-value t)))
|
||||
|
||||
(defun bytecomp--mutargs-nconc (form)
|
||||
;; For `nconc', all arguments but the last are mutated.
|
||||
(number-sequence 1 (- (length form) 2)))
|
||||
|
||||
(defun bytecomp--mutargs-sort (form)
|
||||
;; For `sort', the first argument is mutated if the call is in-place.
|
||||
(and (bytecomp--sort-call-in-place-p form) '(1)))
|
||||
|
||||
(let ((mutating-fns
|
||||
;; FIXME: Should there be a function declaration for this?
|
||||
;;
|
||||
;; (FUNC . ARGS) means that FUNC mutates arguments whose indices are
|
||||
;; in the list ARGS, starting at 1, or all but the last argument if
|
||||
;; ARGS is `all-but-last'.
|
||||
;; in the list ARGS, starting at 1. ARGS can also be a function
|
||||
;; taking the function call form as argument and returning the
|
||||
;; list of indices.
|
||||
'(
|
||||
(setcar 1) (setcdr 1) (aset 1)
|
||||
(nreverse 1)
|
||||
(nconc . all-but-last)
|
||||
(nconc . bytecomp--mutargs-nconc)
|
||||
(nbutlast 1) (ntake 2)
|
||||
(sort 1)
|
||||
(sort . bytecomp--mutargs-sort)
|
||||
(delq 2) (delete 2)
|
||||
(delete-dups 1) (delete-consecutive-dups 1)
|
||||
(plist-put 1)
|
||||
|
|
|
|||
|
|
@ -40,31 +40,34 @@
|
|||
(require 'pcase)
|
||||
|
||||
(defconst ert-font-lock--face-symbol-re
|
||||
(rx (one-or-more (or alphanumeric "-" "_" ".")))
|
||||
"A face symbol matching regex.")
|
||||
(rx (+ (or alphanumeric "-" "_" "." "/")))
|
||||
"A face symbol matching regex.
|
||||
The regexp cannot use character classes as these can be redefined by the
|
||||
major mode of the host language.")
|
||||
|
||||
(defconst ert-font-lock--face-symbol-list-re
|
||||
(rx "("
|
||||
(* whitespace)
|
||||
(one-or-more
|
||||
(seq (regexp ert-font-lock--face-symbol-re)
|
||||
(* whitespace)))
|
||||
(? (regexp ert-font-lock--face-symbol-re))
|
||||
(* (+ whitespace)
|
||||
(regexp ert-font-lock--face-symbol-re))
|
||||
(* whitespace)
|
||||
")")
|
||||
"A face symbol list matching regex.")
|
||||
|
||||
(defconst ert-font-lock--assertion-line-re
|
||||
(rx
|
||||
;; leading column assertion (arrow/caret)
|
||||
(group (or "^" "<-"))
|
||||
(zero-or-more whitespace)
|
||||
(group-n 1 (or "^" "<-"))
|
||||
(* whitespace)
|
||||
;; possible to have many carets on an assertion line
|
||||
(group (zero-or-more (seq "^" (zero-or-more whitespace))))
|
||||
(group-n 2 (* "^" (* whitespace)))
|
||||
;; optional negation of the face specification
|
||||
(group (optional "!"))
|
||||
(zero-or-more whitespace)
|
||||
(group-n 3 (optional "!"))
|
||||
(* whitespace)
|
||||
;; face symbol name or a list of symbols
|
||||
(group (or (regexp ert-font-lock--face-symbol-re)
|
||||
(regexp ert-font-lock--face-symbol-list-re))))
|
||||
(group-n 4 (or (regexp ert-font-lock--face-symbol-re)
|
||||
(regexp ert-font-lock--face-symbol-list-re))))
|
||||
"An ert-font-lock assertion line regex.")
|
||||
|
||||
(defun ert-font-lock--validate-major-mode (mode)
|
||||
|
|
|
|||
|
|
@ -366,13 +366,19 @@ FUNCTION."
|
|||
;; suitable options for specifying the mount namespace and
|
||||
;; suchlike.
|
||||
(setq
|
||||
p (make-process
|
||||
:name name :buffer buffer
|
||||
:command (if (tramp-get-connection-property v "remote-namespace")
|
||||
(append (list "su" "-mm" "-" user "-c") command)
|
||||
(append (list "su" "-" user "-c") command))
|
||||
:coding coding :noquery noquery :connection-type connection-type
|
||||
:sentinel sentinel :stderr stderr))
|
||||
p (let ((android-use-exec-loader nil))
|
||||
(make-process
|
||||
:name name
|
||||
:buffer buffer
|
||||
:command
|
||||
(if (tramp-get-connection-property v "remote-namespace")
|
||||
(append (list "su" "-mm" "-" user "-c") command)
|
||||
(append (list "su" "-" user "-c") command))
|
||||
:coding coding
|
||||
:noquery noquery
|
||||
:connection-type connection-type
|
||||
:sentinel sentinel
|
||||
:stderr stderr)))
|
||||
;; Set filter. Prior Emacs 29.1, it doesn't work reliably
|
||||
;; to provide it as `make-process' argument when filter is
|
||||
;; t. See Bug#51177.
|
||||
|
|
|
|||
|
|
@ -105,7 +105,7 @@
|
|||
("2.3.5.26.3" . "26.3")
|
||||
("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2")
|
||||
("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") ("2.5.4" . "28.3")
|
||||
("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2")))
|
||||
("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2") ("2.6.3-pre" . "29.3")))
|
||||
|
||||
(add-hook 'tramp-unload-hook
|
||||
(lambda ()
|
||||
|
|
|
|||
|
|
@ -50,6 +50,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'lisp-mode)
|
||||
(eval-when-compile 'subr-x) ;For `named-let'.
|
||||
|
||||
(defvar scheme-mode-syntax-table
|
||||
(let ((st (make-syntax-table))
|
||||
|
|
@ -409,26 +410,73 @@ See `run-hooks'."
|
|||
|
||||
(defun scheme-syntax-propertize (beg end)
|
||||
(goto-char beg)
|
||||
(scheme-syntax-propertize-sexp-comment (point) end)
|
||||
(scheme-syntax-propertize-sexp-comment end)
|
||||
(scheme-syntax-propertize-regexp end)
|
||||
(funcall
|
||||
(syntax-propertize-rules
|
||||
("\\(#\\);" (1 (prog1 "< cn"
|
||||
(scheme-syntax-propertize-sexp-comment (point) end)))))
|
||||
(scheme-syntax-propertize-sexp-comment end))))
|
||||
("\\(#\\)/" (1 (when (null (nth 8 (save-excursion
|
||||
(syntax-ppss (match-beginning 0)))))
|
||||
(put-text-property
|
||||
(match-beginning 1)
|
||||
(match-end 1)
|
||||
'syntax-table (string-to-syntax "|"))
|
||||
(scheme-syntax-propertize-regexp end)
|
||||
nil))))
|
||||
(point) end))
|
||||
|
||||
(defun scheme-syntax-propertize-sexp-comment (_ end)
|
||||
(let ((state (syntax-ppss)))
|
||||
(defun scheme-syntax-propertize-sexp-comment (end)
|
||||
(let ((state (syntax-ppss))
|
||||
(checked (point)))
|
||||
(when (eq 2 (nth 7 state))
|
||||
;; It's a sexp-comment. Tell parse-partial-sexp where it ends.
|
||||
(condition-case nil
|
||||
(progn
|
||||
(goto-char (+ 2 (nth 8 state)))
|
||||
;; FIXME: this doesn't handle the case where the sexp
|
||||
;; itself contains a #; comment.
|
||||
(forward-sexp 1)
|
||||
(put-text-property (1- (point)) (point)
|
||||
'syntax-table (string-to-syntax "> cn")))
|
||||
(scan-error (goto-char end))))))
|
||||
(named-let loop ((startpos (+ 2 (nth 8 state))))
|
||||
(let ((found nil))
|
||||
(while
|
||||
(progn
|
||||
(setq found nil)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(goto-char startpos)
|
||||
(forward-sexp 1)
|
||||
(setq found (point)))
|
||||
(scan-error (goto-char end)))
|
||||
;; If there's a nested `#;', the syntax-tables will normally
|
||||
;; consider the `;' to start a normal comment, so the
|
||||
;; (forward-sexp 1) above may have landed at the wrong place.
|
||||
;; So look for `#;' in the text over which we jumped, and
|
||||
;; mark those we found as nested sexp-comments.
|
||||
(let ((limit (or found end)))
|
||||
(when (< checked limit)
|
||||
(goto-char checked)
|
||||
(when (re-search-forward "\\(#\\);" limit 'move)
|
||||
(setq checked (point))
|
||||
(put-text-property (match-beginning 1) (match-end 1)
|
||||
'syntax-table
|
||||
(string-to-syntax "< cn"))
|
||||
(loop (point)))
|
||||
(< (point) limit)))))
|
||||
(when found
|
||||
(goto-char found)
|
||||
(put-text-property (1- found) found
|
||||
'syntax-table (string-to-syntax "> cn"))))))))
|
||||
|
||||
(defun scheme-syntax-propertize-regexp (end)
|
||||
(let* ((state (syntax-ppss))
|
||||
(within-str (nth 3 state))
|
||||
(start-delim-pos (nth 8 state)))
|
||||
(when (and within-str
|
||||
(char-equal ?# (char-after start-delim-pos)))
|
||||
(while (and (re-search-forward "/" end 'move)
|
||||
(eq -1
|
||||
(% (save-excursion
|
||||
(backward-char)
|
||||
(skip-chars-backward "\\\\"))
|
||||
2))))
|
||||
(when (< (point) end)
|
||||
(put-text-property (match-beginning 0) (match-end 0)
|
||||
'syntax-table (string-to-syntax "|"))))))
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode dsssl-mode scheme-mode "DSSSL"
|
||||
|
|
|
|||
|
|
@ -3194,12 +3194,6 @@ shell command and conveniently use this command."
|
|||
|
||||
(defvar-local sh--shellcheck-process nil)
|
||||
|
||||
(defalias 'sh--json-read
|
||||
(if (fboundp 'json-parse-buffer)
|
||||
(lambda () (json-parse-buffer :object-type 'alist))
|
||||
(require 'json)
|
||||
'json-read))
|
||||
|
||||
(defun sh-shellcheck-flymake (report-fn &rest _args)
|
||||
"Flymake backend using the shellcheck program.
|
||||
Takes a Flymake callback REPORT-FN as argument, as expected of a
|
||||
|
|
@ -3223,7 +3217,7 @@ member of `flymake-diagnostic-functions'."
|
|||
(with-current-buffer (process-buffer proc)
|
||||
(goto-char (point-min))
|
||||
(thread-last
|
||||
(sh--json-read)
|
||||
(json-parse-buffer :object-type 'alist)
|
||||
(alist-get 'comments)
|
||||
(seq-filter
|
||||
(lambda (item)
|
||||
|
|
|
|||
|
|
@ -6730,7 +6730,8 @@ android_root_closedir (struct android_vdir *vdir)
|
|||
|
||||
if (dir->directory)
|
||||
closedir (dir->directory);
|
||||
else if (root_fd_references--)
|
||||
|
||||
if (root_fd_references--)
|
||||
;
|
||||
else
|
||||
{
|
||||
|
|
@ -6745,13 +6746,7 @@ android_root_closedir (struct android_vdir *vdir)
|
|||
static int
|
||||
android_root_dirfd (struct android_vdir *vdir)
|
||||
{
|
||||
struct android_unix_vdir *dir;
|
||||
|
||||
dir = (struct android_unix_vdir *) vdir;
|
||||
|
||||
if (dir->directory)
|
||||
return dirfd (dir->directory);
|
||||
|
||||
eassert (root_fd != -1);
|
||||
return root_fd;
|
||||
}
|
||||
|
||||
|
|
@ -6778,13 +6773,13 @@ android_root_opendir (struct android_vnode *vnode)
|
|||
dir->directory = directory;
|
||||
dir->index = 0;
|
||||
|
||||
if (!directory)
|
||||
{
|
||||
/* Allocate a temporary file descriptor for this ersatz root. */
|
||||
if (root_fd < 0)
|
||||
root_fd = open ("/dev/null", O_RDONLY | O_CLOEXEC);
|
||||
root_fd_references++;
|
||||
}
|
||||
/* Allocate a temporary file descriptor for this ersatz root. This is
|
||||
required regardless of the value of DIRECTORY, as android_fstatat
|
||||
and co. will not defer to the VFS layer if a directory file
|
||||
descriptor is not known to be special. */
|
||||
if (root_fd < 0)
|
||||
root_fd = open ("/dev/null", O_RDONLY | O_CLOEXEC);
|
||||
root_fd_references++;
|
||||
|
||||
return &dir->vdir;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1689,6 +1689,22 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
|
|||
bus, build_string (interface), build_string (member));
|
||||
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
|
||||
|
||||
/* A signal could be registered with a nil interface or member. */
|
||||
if (mtype == DBUS_MESSAGE_TYPE_SIGNAL)
|
||||
{
|
||||
key = list4 (QCsignal, bus, Qnil, build_string (member));
|
||||
value = CALLN (Fappend, value,
|
||||
Fgethash (key, Vdbus_registered_objects_table, Qnil));
|
||||
|
||||
key = list4 (QCsignal, bus, build_string (interface), Qnil);
|
||||
value = CALLN (Fappend, value,
|
||||
Fgethash (key, Vdbus_registered_objects_table, Qnil));
|
||||
|
||||
key = list4 (QCsignal, bus, Qnil, Qnil);
|
||||
value = CALLN (Fappend, value,
|
||||
Fgethash (key, Vdbus_registered_objects_table, Qnil));
|
||||
}
|
||||
|
||||
/* Loop over the registered functions. Construct an event. */
|
||||
for (; !NILP (value); value = CDR_SAFE (value))
|
||||
{
|
||||
|
|
|
|||
191
src/json.c
191
src/json.c
|
|
@ -699,24 +699,6 @@ usage: (json-insert OBJECT &rest ARGS) */)
|
|||
}
|
||||
|
||||
|
||||
/* Note that all callers of make_string_from_utf8 and build_string_from_utf8
|
||||
below either pass only value UTF-8 strings or use the function for
|
||||
formatting error messages; in the latter case correctness isn't
|
||||
critical. */
|
||||
|
||||
/* Return a unibyte string containing the sequence of UTF-8 encoding
|
||||
units of the UTF-8 representation of STRING. If STRING does not
|
||||
represent a sequence of Unicode scalar values, return a string with
|
||||
unspecified contents. */
|
||||
|
||||
static Lisp_Object
|
||||
json_encode (Lisp_Object string)
|
||||
{
|
||||
/* FIXME: Raise an error if STRING is not a scalar value
|
||||
sequence. */
|
||||
return encode_string_utf_8 (string, Qnil, false, Qt, Qt);
|
||||
}
|
||||
|
||||
#define JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE 64
|
||||
#define JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE 512
|
||||
|
||||
|
|
@ -1081,52 +1063,21 @@ json_parse_unicode (struct json_parser *parser)
|
|||
return v[0] << 12 | v[1] << 8 | v[2] << 4 | v[3];
|
||||
}
|
||||
|
||||
/* Parses an utf-8 code-point encoding (except the first byte), and
|
||||
returns the numeric value of the code-point (without considering
|
||||
the first byte) */
|
||||
static int
|
||||
json_handle_utf8_tail_bytes (struct json_parser *parser, int n)
|
||||
static AVOID
|
||||
utf8_error (struct json_parser *parser)
|
||||
{
|
||||
int v = 0;
|
||||
for (int i = 0; i < n; i++)
|
||||
{
|
||||
int c = json_input_get (parser);
|
||||
json_byte_workspace_put (parser, c);
|
||||
if ((c & 0xc0) != 0x80)
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
v = (v << 6) | (c & 0x3f);
|
||||
}
|
||||
return v;
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
}
|
||||
|
||||
/* Reads a JSON string, and puts the result into the byte workspace */
|
||||
static void
|
||||
json_parse_string (struct json_parser *parser)
|
||||
/* Parse a string literal. Optionally prepend a ':'.
|
||||
Return the string or an interned symbol. */
|
||||
static Lisp_Object
|
||||
json_parse_string (struct json_parser *parser, bool intern, bool leading_colon)
|
||||
{
|
||||
/* a single_uninteresting byte can be simply copied from the input
|
||||
to output, it doesn't need any extra care. This means all the
|
||||
characters between [0x20;0x7f], except the double quote and
|
||||
the backslash */
|
||||
static const char is_single_uninteresting[256] = {
|
||||
/* 0 1 2 3 4 5 6 7 8 9 a b c d e f */
|
||||
/* 0 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* 1 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* 2 */ 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
/* 3 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
/* 4 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
/* 5 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1,
|
||||
/* 6 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
/* 7 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
||||
/* 8 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* 9 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* a */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* b */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* c */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* d */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* e */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
/* f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
};
|
||||
|
||||
json_byte_workspace_reset (parser);
|
||||
if (leading_colon)
|
||||
json_byte_workspace_put (parser, ':');
|
||||
ptrdiff_t chars_delta = 0; /* nchars - nbytes */
|
||||
for (;;)
|
||||
{
|
||||
/* This if is only here for a possible speedup. If there are 4
|
||||
|
|
@ -1138,10 +1089,10 @@ json_parse_string (struct json_parser *parser)
|
|||
int c1 = parser->input_current[1];
|
||||
int c2 = parser->input_current[2];
|
||||
int c3 = parser->input_current[3];
|
||||
bool v0 = is_single_uninteresting[c0];
|
||||
bool v1 = is_single_uninteresting[c1];
|
||||
bool v2 = is_single_uninteresting[c2];
|
||||
bool v3 = is_single_uninteresting[c3];
|
||||
bool v0 = json_plain_char[c0];
|
||||
bool v1 = json_plain_char[c1];
|
||||
bool v2 = json_plain_char[c2];
|
||||
bool v3 = json_plain_char[c3];
|
||||
if (v0 && v1 && v2 && v3)
|
||||
{
|
||||
json_byte_workspace_put (parser, c0);
|
||||
|
|
@ -1156,43 +1107,62 @@ json_parse_string (struct json_parser *parser)
|
|||
|
||||
int c = json_input_get (parser);
|
||||
parser->current_column++;
|
||||
if (is_single_uninteresting[c])
|
||||
if (json_plain_char[c])
|
||||
{
|
||||
json_byte_workspace_put (parser, c);
|
||||
continue;
|
||||
}
|
||||
|
||||
if (c == '"')
|
||||
return;
|
||||
else if (c & 0x80)
|
||||
{
|
||||
/* Handle utf-8 encoding */
|
||||
ptrdiff_t nbytes
|
||||
= parser->byte_workspace_current - parser->byte_workspace;
|
||||
ptrdiff_t nchars = nbytes - chars_delta;
|
||||
const char *str = (const char *)parser->byte_workspace;
|
||||
return intern ? intern_c_multibyte (str, nchars, nbytes)
|
||||
: make_multibyte_string (str, nchars, nbytes);
|
||||
}
|
||||
|
||||
if (c & 0x80)
|
||||
{
|
||||
/* Parse UTF-8, strictly. This is the correct thing to do
|
||||
whether or not the input is a unibyte or multibyte string. */
|
||||
json_byte_workspace_put (parser, c);
|
||||
if (c < 0xc0)
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
else if (c < 0xe0)
|
||||
unsigned char c1 = json_input_get (parser);
|
||||
if ((c1 & 0xc0) != 0x80)
|
||||
utf8_error (parser);
|
||||
json_byte_workspace_put (parser, c1);
|
||||
if (c <= 0xc1)
|
||||
utf8_error (parser);
|
||||
else if (c <= 0xdf)
|
||||
chars_delta += 1;
|
||||
else if (c <= 0xef)
|
||||
{
|
||||
int n = ((c & 0x1f) << 6
|
||||
| json_handle_utf8_tail_bytes (parser, 1));
|
||||
if (n < 0x80)
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
unsigned char c2 = json_input_get (parser);
|
||||
if ((c2 & 0xc0) != 0x80)
|
||||
utf8_error (parser);
|
||||
int v = ((c & 0x0f) << 12) + ((c1 & 0x3f) << 6) + (c2 & 0x3f);
|
||||
if (v < 0x800 || (v >= 0xd800 && v <= 0xdfff))
|
||||
utf8_error (parser);
|
||||
json_byte_workspace_put (parser, c2);
|
||||
chars_delta += 2;
|
||||
}
|
||||
else if (c < 0xf0)
|
||||
else if (c <= 0xf7)
|
||||
{
|
||||
int n = ((c & 0xf) << 12
|
||||
| json_handle_utf8_tail_bytes (parser, 2));
|
||||
if (n < 0x800 || (n >= 0xd800 && n < 0xe000))
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
}
|
||||
else if (c < 0xf8)
|
||||
{
|
||||
int n = ((c & 0x7) << 18
|
||||
| json_handle_utf8_tail_bytes (parser, 3));
|
||||
if (n < 0x10000 || n > 0x10ffff)
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
unsigned char c2 = json_input_get (parser);
|
||||
unsigned char c3 = json_input_get (parser);
|
||||
if ((c2 & 0xc0) != 0x80 || (c3 & 0xc0) != 0x80)
|
||||
utf8_error (parser);
|
||||
int v = (((c & 0x07) << 18) + ((c1 & 0x3f) << 12)
|
||||
+ ((c2 & 0x3f) << 6) + (c3 & 0x3f));
|
||||
if (v < 0x10000 || v > 0x10ffff)
|
||||
utf8_error (parser);
|
||||
json_byte_workspace_put (parser, c2);
|
||||
json_byte_workspace_put (parser, c3);
|
||||
chars_delta += 3;
|
||||
}
|
||||
else
|
||||
json_signal_error (parser, Qjson_utf8_decode_error);
|
||||
utf8_error (parser);
|
||||
}
|
||||
else if (c == '\\')
|
||||
{
|
||||
|
|
@ -1249,6 +1219,7 @@ json_parse_string (struct json_parser *parser)
|
|||
json_byte_workspace_put (parser, 0xc0 | num >> 6);
|
||||
json_byte_workspace_put (parser,
|
||||
0x80 | (num & 0x3f));
|
||||
chars_delta += 1;
|
||||
}
|
||||
else if (num < 0x10000)
|
||||
{
|
||||
|
|
@ -1258,6 +1229,7 @@ json_parse_string (struct json_parser *parser)
|
|||
| ((num >> 6) & 0x3f)));
|
||||
json_byte_workspace_put (parser,
|
||||
0x80 | (num & 0x3f));
|
||||
chars_delta += 2;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -1270,6 +1242,7 @@ json_parse_string (struct json_parser *parser)
|
|||
| ((num >> 6) & 0x3f)));
|
||||
json_byte_workspace_put (parser,
|
||||
0x80 | (num & 0x3f));
|
||||
chars_delta += 3;
|
||||
}
|
||||
}
|
||||
else
|
||||
|
|
@ -1566,16 +1539,11 @@ json_parse_object (struct json_parser *parser)
|
|||
if (c != '"')
|
||||
json_signal_error (parser, Qjson_parse_error);
|
||||
|
||||
json_byte_workspace_reset (parser);
|
||||
switch (parser->conf.object_type)
|
||||
{
|
||||
case json_object_hashtable:
|
||||
{
|
||||
json_parse_string (parser);
|
||||
Lisp_Object key
|
||||
= make_string_from_utf8 ((char *) parser->byte_workspace,
|
||||
(parser->byte_workspace_current
|
||||
- parser->byte_workspace));
|
||||
Lisp_Object key = json_parse_string (parser, false, false);
|
||||
Lisp_Object value = json_parse_object_member_value (parser);
|
||||
json_make_object_workspace_for (parser, 2);
|
||||
parser->object_workspace[parser->object_workspace_current] = key;
|
||||
|
|
@ -1586,13 +1554,7 @@ json_parse_object (struct json_parser *parser)
|
|||
}
|
||||
case json_object_alist:
|
||||
{
|
||||
json_parse_string (parser);
|
||||
char *workspace = (char *) parser->byte_workspace;
|
||||
ptrdiff_t nbytes
|
||||
= parser->byte_workspace_current - parser->byte_workspace;
|
||||
Lisp_Object key = Fintern (make_string_from_utf8 (workspace,
|
||||
nbytes),
|
||||
Qnil);
|
||||
Lisp_Object key = json_parse_string (parser, true, false);
|
||||
Lisp_Object value = json_parse_object_member_value (parser);
|
||||
Lisp_Object nc = Fcons (Fcons (key, value), Qnil);
|
||||
*cdr = nc;
|
||||
|
|
@ -1601,11 +1563,7 @@ json_parse_object (struct json_parser *parser)
|
|||
}
|
||||
case json_object_plist:
|
||||
{
|
||||
json_byte_workspace_put (parser, ':');
|
||||
json_parse_string (parser);
|
||||
Lisp_Object key = intern_1 ((char *) parser->byte_workspace,
|
||||
(parser->byte_workspace_current
|
||||
- parser->byte_workspace));
|
||||
Lisp_Object key = json_parse_string (parser, true, true);
|
||||
Lisp_Object value = json_parse_object_member_value (parser);
|
||||
Lisp_Object nc = Fcons (key, Qnil);
|
||||
*cdr = nc;
|
||||
|
|
@ -1692,22 +1650,14 @@ json_parse_value (struct json_parser *parser, int c)
|
|||
else if (c == '[')
|
||||
return json_parse_array (parser);
|
||||
else if (c == '"')
|
||||
{
|
||||
json_byte_workspace_reset (parser);
|
||||
json_parse_string (parser);
|
||||
Lisp_Object result
|
||||
= make_string_from_utf8 ((const char *) parser->byte_workspace,
|
||||
(parser->byte_workspace_current
|
||||
- parser->byte_workspace));
|
||||
return result;
|
||||
}
|
||||
return json_parse_string (parser, false, false);
|
||||
else if ((c >= '0' && c <= '9') || (c == '-'))
|
||||
return json_parse_number (parser, c);
|
||||
else
|
||||
{
|
||||
int c2 = json_input_get (parser);
|
||||
int c3 = json_input_get (parser);
|
||||
int c4 = json_input_get (parser);
|
||||
int c2 = json_input_get_if_possible (parser);
|
||||
int c3 = json_input_get_if_possible (parser);
|
||||
int c4 = json_input_get_if_possible (parser);
|
||||
int c5 = json_input_get_if_possible (parser);
|
||||
|
||||
if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e'
|
||||
|
|
@ -1816,14 +1766,13 @@ usage: (json-parse-string STRING &rest ARGS) */)
|
|||
|
||||
Lisp_Object string = args[0];
|
||||
CHECK_STRING (string);
|
||||
Lisp_Object encoded = json_encode (string);
|
||||
struct json_configuration conf
|
||||
= { json_object_hashtable, json_array_array, QCnull, QCfalse };
|
||||
json_parse_args (nargs - 1, args + 1, &conf, true);
|
||||
|
||||
struct json_parser p;
|
||||
const unsigned char *begin = (const unsigned char *) SSDATA (encoded);
|
||||
json_parser_init (&p, conf, begin, begin + SBYTES (encoded), NULL, NULL);
|
||||
const unsigned char *begin = SDATA (string);
|
||||
json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL);
|
||||
record_unwind_protect_ptr (json_parser_done, &p);
|
||||
|
||||
return unbind_to (count,
|
||||
|
|
|
|||
|
|
@ -4744,6 +4744,8 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t,
|
|||
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
|
||||
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
|
||||
extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
extern Lisp_Object intern_c_multibyte (const char *str,
|
||||
ptrdiff_t nchars, ptrdiff_t nbytes);
|
||||
extern void init_symbol (Lisp_Object, Lisp_Object);
|
||||
extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
|
||||
INLINE void
|
||||
|
|
|
|||
12
src/lread.c
12
src/lread.c
|
|
@ -4993,6 +4993,18 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
|
|||
return tem;
|
||||
}
|
||||
|
||||
/* Intern STR of NBYTES bytes and NCHARS characters in the default obarray. */
|
||||
Lisp_Object
|
||||
intern_c_multibyte (const char *str, ptrdiff_t nchars, ptrdiff_t nbytes)
|
||||
{
|
||||
Lisp_Object obarray = check_obarray (Vobarray);
|
||||
Lisp_Object sym = oblookup (obarray, str, nchars, nbytes);
|
||||
if (BARE_SYMBOL_P (sym))
|
||||
return sym;
|
||||
return intern_driver (make_multibyte_string (str, nchars, nbytes),
|
||||
obarray, sym);
|
||||
}
|
||||
|
||||
static void
|
||||
define_symbol (Lisp_Object sym, char const *str)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -44,13 +44,56 @@
|
|||
(goto-char (point-min))
|
||||
,@body))
|
||||
|
||||
(defun ert-font-lock--wrap-begin-end (re)
|
||||
(concat "^" re "$"))
|
||||
|
||||
;;; Regexp tests
|
||||
;;;
|
||||
|
||||
(ert-deftest test-regexp--face-symbol-re ()
|
||||
(let ((re (ert-font-lock--wrap-begin-end
|
||||
ert-font-lock--face-symbol-re)))
|
||||
(should (string-match-p re "font-lock-keyword-face"))
|
||||
(should (string-match-p re "-face"))
|
||||
(should (string-match-p re "weird-package/-face"))
|
||||
(should (string-match-p re "-"))
|
||||
(should (string-match-p re "font-lock.face"))
|
||||
(should-not (string-match-p re "face suffix-with"))
|
||||
(should-not (string-match-p re "("))))
|
||||
|
||||
(ert-deftest test-regexp--face-symbol-list-re ()
|
||||
(let ((re (ert-font-lock--wrap-begin-end
|
||||
ert-font-lock--face-symbol-list-re)))
|
||||
(should (string-match-p re "(face1 face2)"))
|
||||
(should (string-match-p re "(face1)"))
|
||||
(should (string-match-p re "()"))
|
||||
(should-not (string-match-p re ")"))
|
||||
(should-not (string-match-p re "("))))
|
||||
|
||||
(ert-deftest test-regexp--assertion-line-re ()
|
||||
(let ((re (ert-font-lock--wrap-begin-end
|
||||
ert-font-lock--assertion-line-re)))
|
||||
(should (string-match-p re "^ something-face"))
|
||||
(should (string-match-p re "^ !something-face"))
|
||||
(should (string-match-p re "^ (face1 face2)"))
|
||||
(should (string-match-p re "^ !(face1 face2)"))
|
||||
(should (string-match-p re "^ ()"))
|
||||
(should (string-match-p re "^ !()"))
|
||||
(should (string-match-p re "^ nil"))
|
||||
(should (string-match-p re "^ !nil"))
|
||||
(should (string-match-p re "<- something-face"))
|
||||
(should (string-match-p re "<- ^ something-face"))
|
||||
(should (string-match-p re "^^ ^ something-face"))
|
||||
(should (string-match-p re "^ ^something-face"))
|
||||
(should-not (string-match-p re "^ <- ^something-face"))))
|
||||
|
||||
;;; Comment parsing tests
|
||||
;;
|
||||
|
||||
(ert-deftest test-line-comment-p--fundamental ()
|
||||
(with-temp-buffer-str-mode fundamental-mode
|
||||
"// comment\n"
|
||||
(should-not (ert-font-lock--line-comment-p))))
|
||||
"// comment\n"
|
||||
(should-not (ert-font-lock--line-comment-p))))
|
||||
|
||||
(ert-deftest test-line-comment-p--emacs-lisp ()
|
||||
(with-temp-buffer-str-mode emacs-lisp-mode
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
|
||||
(require 'cl-lib)
|
||||
(require 'map)
|
||||
(require 'subr-x)
|
||||
|
||||
(declare-function json-serialize "json.c" (object &rest args))
|
||||
(declare-function json-insert "json.c" (object &rest args))
|
||||
|
|
@ -34,7 +35,6 @@
|
|||
(define-error 'json-tests--error "JSON test error")
|
||||
|
||||
(ert-deftest json-serialize/roundtrip ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
;; The noncharacter U+FFFF should be passed through,
|
||||
;; cf. https://www.unicode.org/faq/private_use.html#noncharacters.
|
||||
(let ((lisp [:null :false t 0 123 -456 3.75 "abc\uFFFFαβγ𝔸𝐁𝖢\"\\"])
|
||||
|
|
@ -53,7 +53,6 @@
|
|||
|
||||
(ert-deftest json-serialize/roundtrip-scalars ()
|
||||
"Check that Bug#42994 is fixed."
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(dolist (case '((:null "null")
|
||||
(:false "false")
|
||||
(t "true")
|
||||
|
|
@ -80,7 +79,6 @@
|
|||
(should (eobp)))))))
|
||||
|
||||
(ert-deftest json-serialize/object ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(let ((table (make-hash-table :test #'equal)))
|
||||
(puthash "abc" [1 2 t] table)
|
||||
(puthash "def" :null table)
|
||||
|
|
@ -125,8 +123,6 @@
|
|||
}")))
|
||||
|
||||
(ert-deftest json-serialize/object-with-duplicate-keys ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
|
||||
(dolist (n '(1 5 20 100))
|
||||
(let ((symbols (mapcar (lambda (i) (make-symbol (format "s%d" i)))
|
||||
(number-sequence 1 n)))
|
||||
|
|
@ -160,7 +156,9 @@
|
|||
)
|
||||
|
||||
(ert-deftest json-parse-string/object ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
:expected-result :failed
|
||||
;; FIXME: This currently fails. Should the parser deduplicate keys?
|
||||
;; Never, always, or for alist and plist only?
|
||||
(let ((input
|
||||
"{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
|
||||
(let ((actual (json-parse-string input)))
|
||||
|
|
@ -173,8 +171,16 @@
|
|||
(should (equal (json-parse-string input :object-type 'plist)
|
||||
'(:abc [9 :false] :def :null)))))
|
||||
|
||||
(ert-deftest json-parse-string/object-unicode-keys ()
|
||||
(let ((input "{\"é\":1,\"☃\":2,\"𐌐\":3}"))
|
||||
(let ((actual (json-parse-string input)))
|
||||
(should (equal (sort (hash-table-keys actual)) '("é" "☃" "𐌐"))))
|
||||
(should (equal (json-parse-string input :object-type 'alist)
|
||||
'((é . 1) (☃ . 2) (𐌐 . 3))))
|
||||
(should (equal (json-parse-string input :object-type 'plist)
|
||||
'(:é 1 :☃ 2 :𐌐 3)))))
|
||||
|
||||
(ert-deftest json-parse-string/array ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(let ((input "[\"a\", 1, [\"b\", 2]]"))
|
||||
(should (equal (json-parse-string input)
|
||||
["a" 1 ["b" 2]]))
|
||||
|
|
@ -182,7 +188,6 @@
|
|||
'("a" 1 ("b" 2))))))
|
||||
|
||||
(ert-deftest json-parse-string/string ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)
|
||||
(should (equal (json-parse-string "[\"foo \\\"bar\\\"\"]") ["foo \"bar\""]))
|
||||
(should (equal (json-parse-string "[\"abcαβγ\"]") ["abcαβγ"]))
|
||||
|
|
@ -190,11 +195,10 @@
|
|||
["\nasdфывfgh\t"]))
|
||||
(should (equal (json-parse-string "[\"\\uD834\\uDD1E\"]") ["\U0001D11E"]))
|
||||
(should-error (json-parse-string "foo") :type 'json-parse-error)
|
||||
;; FIXME: Is this the right behavior?
|
||||
(should (equal (json-parse-string "[\"\u00C4\xC3\x84\"]") ["\u00C4\u00C4"])))
|
||||
(should-error (json-parse-string "[\"\u00C4\xC3\x84\"]")
|
||||
:type 'json-utf8-decode-error))
|
||||
|
||||
(ert-deftest json-serialize/string ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(should (equal (json-serialize ["foo"]) "[\"foo\"]"))
|
||||
(should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]"))
|
||||
(should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"])
|
||||
|
|
@ -204,17 +208,27 @@
|
|||
(should-error (json-serialize ["\u00C4\xC3\x84"])))
|
||||
|
||||
(ert-deftest json-serialize/invalid-unicode ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(should-error (json-serialize ["a\uDBBBb"]) :type 'wrong-type-argument)
|
||||
(should-error (json-serialize ["u\x110000v"]) :type 'wrong-type-argument)
|
||||
(should-error (json-serialize ["u\x3FFFFFv"]) :type 'wrong-type-argument)
|
||||
(should-error (json-serialize ["u\xCCv"]) :type 'wrong-type-argument)
|
||||
(should-error (json-serialize ["u\u00C4\xCCv"]) :type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest json-parse-string/short ()
|
||||
(should-error (json-parse-string "") :type 'json-end-of-file)
|
||||
(should-error (json-parse-string " ") :type 'json-end-of-file)
|
||||
(dolist (s '("a" "ab" "abc" "abcd" "\0" "\1"
|
||||
"t" "tr" "tru" "truE" "truee"
|
||||
"n" "nu" "nul" "nulL" "nulll"
|
||||
"f" "fa" "fal" "fals" "falsE" "falsee"))
|
||||
(condition-case err
|
||||
(json-parse-string s)
|
||||
(error
|
||||
(should (eq (car err) 'json-parse-error)))
|
||||
(:success (error "parsing %S should fail" s)))))
|
||||
|
||||
(ert-deftest json-parse-string/null ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(should-error (json-parse-string "\x00") :type 'wrong-type-argument)
|
||||
(should (json-parse-string "[\"a\\u0000b\"]"))
|
||||
(should (equal (json-parse-string "[\"a\\u0000b\"]") ["a\0b"]))
|
||||
(let* ((string "{\"foo\":\"this is a string including a literal \\u0000\"}")
|
||||
(data (json-parse-string string)))
|
||||
(should (hash-table-p data))
|
||||
|
|
@ -224,43 +238,43 @@
|
|||
"Some examples from
|
||||
https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt.
|
||||
Test with both unibyte and multibyte strings."
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
;; Invalid UTF-8 code unit sequences.
|
||||
(should-error (json-parse-string "[\"\x80\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\x80\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\xBF\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xBF\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\xFE\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xFE\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\xC0\xAF\"]") :type 'json-parse-error)
|
||||
(should-error (json-parse-string "[\"\x80\"]") :type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\x80\"]")
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\xBF\"]") :type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xBF\"]")
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\xFE\"]") :type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xFE\"]")
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\xC0\xAF\"]")
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xC0\xAF\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xC0\x80\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
;; Surrogates.
|
||||
(should-error (json-parse-string "[\"\uDB7F\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\xED\xAD\xBF\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\uDB7F\uDFFF\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\xED\xAD\xBF\xED\xBF\xBF\"]")
|
||||
:type 'json-parse-error)
|
||||
:type 'json-utf8-decode-error)
|
||||
(should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\xED\xBF\xBF\"]")
|
||||
:type 'json-parse-error))
|
||||
:type 'json-utf8-decode-error))
|
||||
|
||||
(ert-deftest json-parse-string/incomplete ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(should-error (json-parse-string "[123") :type 'json-end-of-file))
|
||||
|
||||
(ert-deftest json-parse-string/trailing ()
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(should-error (json-parse-string "[123] [456]") :type 'json-trailing-content))
|
||||
|
||||
(ert-deftest json-parse-buffer/incomplete ()
|
||||
(skip-unless (fboundp 'json-parse-buffer))
|
||||
(with-temp-buffer
|
||||
(insert "[123")
|
||||
(goto-char 1)
|
||||
|
|
@ -268,7 +282,6 @@ Test with both unibyte and multibyte strings."
|
|||
(should (bobp))))
|
||||
|
||||
(ert-deftest json-parse-buffer/trailing ()
|
||||
(skip-unless (fboundp 'json-parse-buffer))
|
||||
(with-temp-buffer
|
||||
(insert "[123] [456]")
|
||||
(goto-char 1)
|
||||
|
|
@ -277,8 +290,6 @@ Test with both unibyte and multibyte strings."
|
|||
(should (looking-at-p (rx " [456]" eos)))))
|
||||
|
||||
(ert-deftest json-parse-with-custom-null-and-false-objects ()
|
||||
(skip-unless (and (fboundp 'json-serialize)
|
||||
(fboundp 'json-parse-string)))
|
||||
(let* ((input
|
||||
"{ \"abc\" : [9, false] , \"def\" : null }")
|
||||
(output
|
||||
|
|
@ -316,7 +327,6 @@ Test with both unibyte and multibyte strings."
|
|||
(should-error (json-serialize '() :object-type 'alist))))
|
||||
|
||||
(ert-deftest json-insert/signal ()
|
||||
(skip-unless (fboundp 'json-insert))
|
||||
(with-temp-buffer
|
||||
(let ((calls 0))
|
||||
(add-hook 'after-change-functions
|
||||
|
|
@ -331,7 +341,6 @@ Test with both unibyte and multibyte strings."
|
|||
(should (equal calls 1)))))
|
||||
|
||||
(ert-deftest json-insert/throw ()
|
||||
(skip-unless (fboundp 'json-insert))
|
||||
(with-temp-buffer
|
||||
(let ((calls 0))
|
||||
(add-hook 'after-change-functions
|
||||
|
|
@ -347,7 +356,6 @@ Test with both unibyte and multibyte strings."
|
|||
(should (equal calls 1)))))
|
||||
|
||||
(ert-deftest json-serialize/bignum ()
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(should (equal (json-serialize (vector (1+ most-positive-fixnum)
|
||||
(1- most-negative-fixnum)))
|
||||
(format "[%d,%d]"
|
||||
|
|
@ -356,12 +364,10 @@ Test with both unibyte and multibyte strings."
|
|||
|
||||
(ert-deftest json-parse-string/wrong-type ()
|
||||
"Check that Bug#42113 is fixed."
|
||||
(skip-unless (fboundp 'json-parse-string))
|
||||
(should-error (json-parse-string 1) :type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest json-serialize/wrong-hash-key-type ()
|
||||
"Check that Bug#42113 is fixed."
|
||||
(skip-unless (fboundp 'json-serialize))
|
||||
(let ((table (make-hash-table :test #'eq)))
|
||||
(puthash 1 2 table)
|
||||
(should-error (json-serialize table) :type 'wrong-type-argument)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue