add setcar setcdr

diff --git a/src/comp.c b/src/comp.c
index 1c2a5818be0d85885897c0c4ae14e22c74c02b1c..aa4bb7fa45c3e4bda962e00af2c66336211a58d5 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -1447,12 +1447,19 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
        case Bnreverse:
          error ("Bnreverse not supported");
          break;
+
        case Bsetcar:
-         error ("Bsetcar not supported");
+         POP2;
+         res = comp_emit_call ("Fsetcar", comp.lisp_obj_type, 2, args);
+         PUSH_LVAL (res);
          break;
+
        case Bsetcdr:
-         error ("Bsetcdr not supported");
+         POP2;
+         res = comp_emit_call ("Fsetcdr", comp.lisp_obj_type, 2, args);
+         PUSH_LVAL (res);
          break;
+
        case Bcar_safe:
          error ("Bcar_safe not supported");
          break;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index f83fa8c8be9ead2efc9da76f79771eecca1c9f2f..e7d5ca67f473c68f25b2316fc36167f3082a22de 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -233,6 +233,23 @@
   (should (eq (comp-tests-geq-f 3 3) t))
   (should (eq (comp-tests-geq-f 2 3) nil)))
 
+(ert-deftest comp-tests-setcarcdr ()
+  "Testing setcar setcdr."
+  (defun comp-tests-setcar-f (x y)
+    (setcar x y)
+    x)
+  (defun comp-tests-setcdr-f (x y)
+    (setcdr x y)
+    x)
+
+  (byte-compile #'comp-tests-setcar-f)
+  (byte-compile #'comp-tests-setcdr-f)
+  (native-compile #'comp-tests-setcar-f)
+  (native-compile #'comp-tests-setcdr-f)
+
+  (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
+  (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3))))
+
 (ert-deftest comp-tests-gc ()
   "Try to do some longer computation to let the gc kick in."
   (dotimes (_ 100000)