procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-07-15 07:54:24 +08:00
commit b6be92ffb6
4 changed files with 102 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lisp/vc/ediff-wind.el
View file

@ -883,6 +883,9 @@ Create a new splittable frame if none is found."
(not (ediff-frame-has-dedicated-windows (window-frame wind)))
)))
(defvar x-fast-protocol-requests)
(declare-function x-change-window-property "xfns.c")
(defun ediff-frame-make-utility (frame)
(let ((x-fast-protocol-requests t))
(x-change-window-property

42
src/bytecode.c
View file

@ -646,7 +646,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
if (CONSP (TOP))
TOP = XCAR (TOP);
else if (!NILP (TOP))
wrong_type_argument (Qlistp, TOP);
{
record_in_backtrace (Qcar, &TOP, 1);
wrong_type_argument (Qlistp, TOP);
}
NEXT;
CASE (Beq):
@ -668,7 +671,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
if (CONSP (TOP))
TOP = XCDR (TOP);
else if (!NILP (TOP))
wrong_type_argument (Qlistp, TOP);
{
record_in_backtrace (Qcdr, &TOP, 1);
wrong_type_argument (Qlistp, TOP);
}
NEXT;
}
@ -1032,7 +1038,15 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
{
for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
v2 = XCDR (v2);
TOP = CAR (v2);
if (CONSP (v2))
TOP = XCAR (v2);
else if (NILP (v2))
TOP = Qnil;
else
{
record_in_backtrace (Qnth, &TOP, 2);
wrong_type_argument (Qlistp, v2);
}
}
else
TOP = Fnth (v1, v2);
@ -1552,7 +1566,15 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
/* Like the fast case for Bnth, but with args reversed. */
for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--)
v1 = XCDR (v1);
TOP = CAR (v1);
if (CONSP (v1))
TOP = XCAR (v1);
else if (NILP (v1))
TOP = Qnil;
else
{
record_in_backtrace (Qelt, &TOP, 2);
wrong_type_argument (Qlistp, v1);
}
}
else
TOP = Felt (v1, v2);
@ -1581,7 +1603,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
{
Lisp_Object newval = POP;
Lisp_Object cell = TOP;
CHECK_CONS (cell);
if (!CONSP (cell))
{
record_in_backtrace (Qsetcar, &TOP, 2);
wrong_type_argument (Qconsp, cell);
}
CHECK_IMPURE (cell, XCONS (cell));
XSETCAR (cell, newval);
TOP = newval;
@ -1592,7 +1618,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
{
Lisp_Object newval = POP;
Lisp_Object cell = TOP;
CHECK_CONS (cell);
if (!CONSP (cell))
{
record_in_backtrace (Qsetcdr, &TOP, 2);
wrong_type_argument (Qconsp, cell);
}
CHECK_IMPURE (cell, XCONS (cell));
XSETCDR (cell, newval);
TOP = newval;

5
src/data.c
View file

@ -4110,7 +4110,12 @@ syms_of_data (void)
DEFSYM (Qunevalled, "unevalled");
DEFSYM (Qmany, "many");
DEFSYM (Qcar, "car");
DEFSYM (Qcdr, "cdr");
DEFSYM (Qnth, "nth");
DEFSYM (Qelt, "elt");
DEFSYM (Qsetcar, "setcar");
DEFSYM (Qsetcdr, "setcdr");
error_tail = pure_cons (Qerror, Qnil);

58
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -1929,6 +1929,64 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
"#4=(a #5=(#4# b . #6=(#5# c . #4#)) (#6# d))"
")"))))))
(require 'backtrace)
(defun bytecomp-tests--error-frame (fun args)
"Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)."
(let* ((debugger
(lambda (&rest args)
;; Make sure Emacs doesn't think our debugger is buggy.
(cl-incf num-nonmacro-input-events)
(throw 'bytecomp-tests--backtrace
(cons args (cadr (backtrace-get-frames debugger))))))
(debug-on-error t)
(backtrace-on-error-noninteractive nil)
(debug-on-quit t)
(debug-ignored-errors nil))
(catch 'bytecomp-tests--backtrace
(apply fun args))))
(defconst bytecomp-tests--byte-op-error-cases
'(((car a) (wrong-type-argument listp a))
((cdr 3) (wrong-type-argument listp 3))
((setcar 4 b) (wrong-type-argument consp 4))
((setcdr c 5) (wrong-type-argument consp c))
((nth 2 "abcd") (wrong-type-argument listp "abcd"))
((elt (x y . z) 2) (wrong-type-argument listp z))
;; Many more to add
))
(ert-deftest bytecomp--byte-op-error-backtrace ()
"Check that signalling byte ops show up in the backtrace."
(dolist (case bytecomp-tests--byte-op-error-cases)
(ert-info ((prin1-to-string case) :prefix "case: ")
(let* ((call (nth 0 case))
(expected-error (nth 1 case))
(fun-sym (car call))
(actuals (cdr call)))
;; Test both calling the function directly, and calling
;; a byte-compiled η-expansion (lambda (ARGS...) (FUN ARGS...))
;; which should turn the function call into a byte-op.
(dolist (byte-op '(nil t))
(ert-info ((prin1-to-string byte-op) :prefix "byte-op: ")
(let* ((fun
(if byte-op
(let* ((nargs (length (cdr call)))
(formals (mapcar (lambda (i)
(intern (format "x%d" i)))
(number-sequence 1 nargs))))
(byte-compile
`(lambda ,formals (,fun-sym ,@formals))))
fun-sym))
(error-frame (bytecomp-tests--error-frame fun actuals)))
(should (consp error-frame))
(should (equal (car error-frame) (list 'error expected-error)))
(let ((frame (cdr error-frame)))
(should (equal (type-of frame) 'backtrace-frame))
(should (equal (cons (backtrace-frame-fun frame)
(backtrace-frame-args frame))
call))))))))))
;; Local Variables:
;; no-byte-compile: t
;; End: