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

4 files changed, 102 insertions, 6 deletions

diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 3077c562d63..7d7f849b09c 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -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
diff --git a/src/bytecode.c b/src/bytecode.c
index 4207ff0b71f..2eb53b0428a 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -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;
diff --git a/src/data.c b/src/data.c
index 5a31462d8ca..108ed97d1f6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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);
 
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 278496f5259..9813e9459c8 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -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: