fix setcar

diff --git a/src/comp.c b/src/comp.c
index 4973a517d6f13af5085287045f72e0b8f563e13c..538169c0b2a5fb4bff1a8b9b4c5ff9e68c089ca1 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -657,7 +657,7 @@ emit_VECTORLIKEP (gcc_jit_rvalue *obj)
 static gcc_jit_rvalue *
 emit_CONSP (gcc_jit_rvalue *obj)
 {
- emit_comment ("CONSP");
+  emit_comment ("CONSP");
 
   return emit_TAGGEDP (obj, Lisp_Cons);
 }
@@ -928,11 +928,14 @@ emit_CHECK_CONS (gcc_jit_rvalue *x)
       emit_lisp_obj_from_ptr (Qconsp),
       x };
 
-  gcc_jit_context_new_call (comp.ctxt,
-                           NULL,
-                           comp.check_type,
-                           3,
-                           args);
+  gcc_jit_block_add_eval (
+    comp.block->gcc_bb,
+    NULL,
+    gcc_jit_context_new_call (comp.ctxt,
+                             NULL,
+                             comp.check_type,
+                             3,
+                             args));
 }
 
 static gcc_jit_rvalue *
@@ -1497,11 +1500,28 @@ define_setcar (void)
   comp.block = init_block;
   comp.func = comp.setcar;
 
+  /* CHECK_CONS (cell); */
   emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell));
 
+  /* CHECK_IMPURE (cell, XCONS (cell)); */
+  gcc_jit_rvalue *args[] =
+    { gcc_jit_param_as_rvalue (cell),
+      emit_XCONS (gcc_jit_param_as_rvalue (cell)) };
+
+  gcc_jit_block_add_eval (
+    init_block->gcc_bb,
+    NULL,
+    gcc_jit_context_new_call (comp.ctxt,
+                             NULL,
+                             comp.check_impure,
+                             2,
+                             args));
+
+  /* XSETCAR (cell, newcar); */
   emit_XSETCAR (gcc_jit_param_as_rvalue (cell),
                gcc_jit_param_as_rvalue (new_car));
 
+  /* return newcar; */
   gcc_jit_block_end_with_return (init_block->gcc_bb,
                                 NULL,
                                 gcc_jit_param_as_rvalue (new_car));
@@ -1600,9 +1620,7 @@ define_CHECK_IMPURE (void)
     comp.block = init_block;
     comp.func = comp.check_impure;
 
-    emit_cond_jump (
-      emit_cast (comp.bool_type,
-                emit_PURE_P (gcc_jit_param_as_rvalue (param[0]))), /* FIXME */
+    emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
       err_block,
       ok_block);
     gcc_jit_block_end_with_void_return (ok_block->gcc_bb, NULL);

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8fd3ca2e197a4fcdc747026d9e85706fbcc6727c..47c61c82bdddb25bd970d34edc806287f06f73b6 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -284,7 +284,12 @@
   (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))))
+  (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
+  (should (equal (condition-case
+                     err
+                     (comp-tests-setcar-f 3 10)
+                   (error err))
+                 '(wrong-type-argument consp 3))))
 
 (defun comp-bubble-sort ()
   "Run bubble sort."