From: Po Lu <luangruo@yahoo.com>
Date: Mon, 22 Jul 2024 01:56:08 +0000 (+0800)
Subject: Prohibit unbinding of built-in variables
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1fcfad9e67c8ea996f87a522cfacefaf49e16ec8;p=emacs.git

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 3490d4985c9..752856abf09 100644
--- 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 a1959f62fd3..a631aabb605 100644
--- 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