master 82f5f3b8a26 2/4: Provide backtrace for byte-ops aref and aset

[Mattias Engdegård]

branch: master
commit 82f5f3b8a26249db0679bb7dc38c44352e8fbdf5
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Provide backtrace for byte-ops aref and aset
    
    Produce synthetic backtrace entries for `aref` and `aset` byte-ops
    when the index is non-fixnum, or is out of range for vector or record
    arguments (bug#64613).
    
    * src/bytecode.c (exec_byte_code): Detect type and range errors
    in-line for aref and aset.
    * src/data.c (syms_of_data): Declare symbols Qaref and Qaset.
    * test/lisp/emacs-lisp/bytecomp-tests.el
    (bytecomp-tests--byte-op-error-cases): Add test cases.
---
 src/bytecode.c                         | 46 ++++++++++++++++++++++++----------
 src/data.c                             |  2 ++
 test/lisp/emacs-lisp/bytecomp-tests.el |  9 +++++++
 3 files changed, 44 insertions(+), 13 deletions(-)

diff --git a/src/bytecode.c b/src/bytecode.c
index 2eb53b0428a..c53ef678edd 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1115,14 +1115,24 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t 
args_template,
          {
            Lisp_Object idxval = POP;
            Lisp_Object arrayval = TOP;
+           if (!FIXNUMP (idxval))
+             {
+               record_in_backtrace (Qaref, &TOP, 2);
+               wrong_type_argument (Qfixnump, idxval);
+             }
            ptrdiff_t size;
-           ptrdiff_t idx;
            if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true))
-                || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true)))
-               && FIXNUMP (idxval)
-               && (idx = XFIXNUM (idxval),
-                   idx >= 0 && idx < size))
-             TOP = AREF (arrayval, idx);
+                || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))))
+             {
+               ptrdiff_t idx = XFIXNUM (idxval);
+               if (idx >= 0 && idx < size)
+                 TOP = AREF (arrayval, idx);
+               else
+                 {
+                   record_in_backtrace (Qaref, &TOP, 2);
+                   args_out_of_range (arrayval, idxval);
+                 }
+             }
            else
              TOP = Faref (arrayval, idxval);
            NEXT;
@@ -1133,16 +1143,26 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t 
args_template,
            Lisp_Object newelt = POP;
            Lisp_Object idxval = POP;
            Lisp_Object arrayval = TOP;
+           if (!FIXNUMP (idxval))
+             {
+               record_in_backtrace (Qaset, &TOP, 3);
+               wrong_type_argument (Qfixnump, idxval);
+             }
            ptrdiff_t size;
-           ptrdiff_t idx;
            if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true))
-                || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true)))
-               && FIXNUMP (idxval)
-               && (idx = XFIXNUM (idxval),
-                   idx >= 0 && idx < size))
+                || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))))
              {
-               ASET (arrayval, idx, newelt);
-               TOP = newelt;
+               ptrdiff_t idx = XFIXNUM (idxval);
+               if (idx >= 0 && idx < size)
+                 {
+                   ASET (arrayval, idx, newelt);
+                   TOP = newelt;
+                 }
+               else
+                 {
+                   record_in_backtrace (Qaset, &TOP, 3);
+                   args_out_of_range (arrayval, idxval);
+                 }
              }
            else
              TOP = Faset (arrayval, idxval, newelt);
diff --git a/src/data.c b/src/data.c
index 108ed97d1f6..619ab8fde64 100644
--- a/src/data.c
+++ b/src/data.c
@@ -4116,6 +4116,8 @@ syms_of_data (void)
   DEFSYM (Qelt, "elt");
   DEFSYM (Qsetcar, "setcar");
   DEFSYM (Qsetcdr, "setcdr");
+  DEFSYM (Qaref, "aref");
+  DEFSYM (Qaset, "aset");
 
   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 16c6408c921..b549ae1fe09 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1953,6 +1953,15 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode 
js-mode python-mode)) \
     ((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))
+    ((aref [2 3 5] p) (wrong-type-argument fixnump p))
+    ((aref #s(a b c) p) (wrong-type-argument fixnump p))
+    ((aref "abc" p) (wrong-type-argument fixnump p))
+    ((aref [2 3 5] 3) (args-out-of-range [2 3 5] 3))
+    ((aref #s(a b c) 3) (args-out-of-range #s(a b c) 3))
+    ((aset [2 3 5] q 1) (wrong-type-argument fixnump q))
+    ((aset #s(a b c) q 1) (wrong-type-argument fixnump q))
+    ((aset [2 3 5] -1 1) (args-out-of-range [2 3 5] -1))
+    ((aset #s(a b c) -1 1) (args-out-of-range #s(a b c) -1))
     ;; Many more to add
     ))