procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Prohibit unbinding of built-in variables

Browse source 
* 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.
This commit is contained in:
Po Lu 2024-07-22 09:56:08 +08:00
parent 4868a17396
commit da0165a01e
2 changed files with 32 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
src/data.c
View file

@ -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 ();

11
test/src/data-tests.el
View file

@ -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