Bcar_safe Bcdr_safe support

diff --git a/src/comp.c b/src/comp.c
index 65e480b5dafa6fa8b36f28f8537e12daa9a7d4b5..4f50c1cc7c244a5bd8fbeb1576539727f713e1ed 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -1863,10 +1863,15 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
        CASE_CALL_NARGS (setcdr, 2);
 
        case Bcar_safe:
-         error ("Bcar_safe not supported");
+         POP2;
+         res = emit_call ("CAR_SAFE", comp.lisp_obj_type, 1, args);
+         PUSH_RVAL (res);
          break;
+
        case Bcdr_safe:
-         error ("Bcdr_safe not supported");
+         POP2;
+         res = emit_call ("CDR_SAFE", comp.lisp_obj_type, 1, args);
+         PUSH_RVAL (res);
          break;
 
        case Bnconc:
@@ -2189,7 +2194,6 @@ Lisp_Object helper_unbind_n (int val);
 
 bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (const union vectorlike_header *a,
                                       enum pvec_type code);
-
 Lisp_Object
 helper_save_window_excursion (Lisp_Object v1)
 {

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 931b9e060942194a4ef43fa4ca57e88c454b4670..6a643df9d3ec136248bf96145a9d8b8eb8bd2698 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -45,11 +45,25 @@
   "Testing cons car cdr."
   (defun comp-tests-list-f ()
     (list 1 2 3))
+  (defun comp-tests-car-safe-f (x)
+    ;; Bcar_safe
+    (car-safe x))
+  (defun comp-tests-cdr-safe-f (x)
+    ;; Bcdr_safe
+    (cdr-safe x))
 
   (byte-compile #'comp-tests-list-f)
   (native-compile #'comp-tests-list-f)
-
-  (should (equal (comp-tests-list-f) '(1 2 3))))
+  (byte-compile #'comp-tests-car-safe-f)
+  (native-compile #'comp-tests-car-safe-f)
+  (byte-compile #'comp-tests-cdr-safe-f)
+  (native-compile #'comp-tests-cdr-safe-f)
+
+  (should (equal (comp-tests-list-f) '(1 2 3)))
+  (should (= (comp-tests-car-safe-f '(1 . 2)) 1))
+  (should (null (comp-tests-car-safe-f 'a)))
+  (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2))
+  (should (null (comp-tests-cdr-safe-f 'a))))
 
 (ert-deftest  comp-tests-cons-car-cdr ()
   "Testing cons car cdr."