Prohibit unbinding of built-in variables

* src/data.c (set_internal): Signal error if a BLV with a
redirect or a forwarded symbol is being unbound.

* test/src/data-tests.el (binding-test-makunbound-built-in): New
test.

(cherry picked from commit da0165a01e01dcb4334feee03b462ac09ceb0f8c)

diff --git a/src/data.c b/src/data.c
index 3490d4985c9053a6593a05b4902270452882d1ed..752856abf09879d040973decf7605cb71ac24b35 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1642,7 +1642,7 @@ void
 set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
               enum Set_Internal_Bind bindflag)
 {
-  bool voide = BASE_EQ (newval, Qunbound);
+  bool unbinding_p = BASE_EQ (newval, Qunbound);
 
   /* If restoring in a dead buffer, do nothing.  */
 
@@ -1661,10 +1661,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
     case SYMBOL_TRAPPED_WRITE:
       /* Setting due to thread-switching doesn't count.  */
       if (bindflag != SET_INTERNAL_THREAD_SWITCH)
-        notify_variable_watchers (symbol, voide? Qnil : newval,
-                                  (bindflag == SET_INTERNAL_BIND? Qlet :
-                                   bindflag == SET_INTERNAL_UNBIND? Qunlet :
-                                   voide? Qmakunbound : Qset),
+        notify_variable_watchers (symbol, (unbinding_p ? Qnil : newval),
+                                  (bindflag == SET_INTERNAL_BIND
+                                  ? Qlet
+                                  : (bindflag == SET_INTERNAL_UNBIND
+                                     ? Qunlet
+                                     : (unbinding_p
+                                        ? Qmakunbound : Qset))),
                                   where);
       break;
 
@@ -1682,6 +1685,11 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
     case SYMBOL_LOCALIZED:
       {
        struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+
+       if (unbinding_p && blv->fwd.fwdptr)
+         /* Forbid unbinding built-in variables.  */
+         error ("Built-in variables may not be unbound");
+
        if (NILP (where))
          XSETBUFFER (where, current_buffer);
 
@@ -1746,16 +1754,9 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
        set_blv_value (blv, newval);
 
        if (blv->fwd.fwdptr)
-         {
-           if (voide)
-             /* If storing void (making the symbol void), forward only through
-                buffer-local indicator, not through Lisp_Objfwd, etc.  */
-             blv->fwd.fwdptr = NULL;
-           else
-             store_symval_forwarding (blv->fwd, newval,
-                                      BUFFERP (where)
-                                      ? XBUFFER (where) : current_buffer);
-         }
+         store_symval_forwarding (blv->fwd, newval, (BUFFERP (where)
+                                                     ? XBUFFER (where)
+                                                     : current_buffer));
        break;
       }
     case SYMBOL_FORWARDED:
@@ -1763,6 +1764,11 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
        struct buffer *buf
          = BUFFERP (where) ? XBUFFER (where) : current_buffer;
        lispfwd innercontents = SYMBOL_FWD (sym);
+
+       if (unbinding_p)
+         /* Forbid unbinding built-in variables.  */
+         error ("Built-in variables may not be unbound");
+
        if (BUFFER_OBJFWDP (innercontents))
          {
            int offset = XBUFFER_OBJFWD (innercontents)->offset;
@@ -1778,14 +1784,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
              }
          }
 
-       if (voide)
-         { /* If storing void (making the symbol void), forward only through
-              buffer-local indicator, not through Lisp_Objfwd, etc.  */
-           sym->u.s.redirect = SYMBOL_PLAINVAL;
-           SET_SYMBOL_VAL (sym, newval);
-         }
-       else
-         store_symval_forwarding (/* sym, */ innercontents, newval, buf);
+       store_symval_forwarding (/* sym, */ innercontents, newval, buf);
        break;
       }
     default: emacs_abort ();

diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a1959f62fd31715f7cca56f3c375443f029d6a89..a631aabb6054a18793cb7caa8ff85448b70ef256 100644 (file)
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -219,6 +219,16 @@ comparing the subr with a much slower Lisp implementation."
          do (error "FAILED testcase %S %3S %3S %3S"
                    pos lf cnt rcnt)))))
 
+(ert-deftest binding-test-makunbound-built-in ()
+  "Verify that attempts to `makunbound' built-in symbols are rejected."
+  (should-error (makunbound 'initial-window-system))
+  (let ((initial-window-system 'x))
+    (should-error (makunbound 'initial-window-system)))
+  (should-error
+   (makunbound (make-local-variable 'initial-window-system)))
+  (let ((initial-window-system 'x))
+    (should-error (makunbound 'initial-window-system))))
+
 (defconst bool-vector-test-vectors
 '(""
   "0"
@@ -874,5 +884,4 @@ comparing the subr with a much slower Lisp implementation."
              ((eq subtype 'function) (cl-functionp val))
              (t (should-not (cl-typep val subtype))))))))))
 
-
 ;;; data-tests.el ends here