Give warning if losing value to defvaralias (Bug#5950)

* src/eval.c (Fdefvaralias): Call `display-warning' if the alias
target has a non-eq value to the variable being aliased.
* test/src/eval-tests.el (defvaralias-overwrite-warning): New test.

diff --git a/src/eval.c b/src/eval.c
index 86011a234c0b4f5eb81455b12c826c999f0c7ca9..5c7cb3196a68890edac8ff8fce934d5318e92359 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -623,6 +623,16 @@ The return value is BASE-VARIABLE.  */)
   if (NILP (Fboundp (base_variable)))
     set_internal (base_variable, find_symbol_value (new_alias),
                   Qnil, SET_INTERNAL_BIND);
+  else if (!NILP (Fboundp (new_alias))
+           && !EQ (find_symbol_value (new_alias),
+                   find_symbol_value (base_variable)))
+    call2 (intern ("display-warning"),
+           list3 (intern ("defvaralias"), intern ("losing-value"), new_alias),
+           CALLN (Fformat_message,
+                  build_string
+                  ("Overwriting value of `%s' by aliasing to `%s'"),
+                  new_alias, base_variable));
+
   {
     union specbinding *p;
 

diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 319dd91c86a9a4f2f7eb7d35b632e4973ca63651..281d959b5306bebee60b440ef1d66c3288c2da89 100644 (file)
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (require 'ert)
+(eval-when-compile (require 'cl-lib))
 
 (ert-deftest eval-tests--bug24673 ()
   "Check that Bug#24673 has been fixed."
@@ -117,4 +118,25 @@ crash/abort/malloc assert failure on the next test."
   "Check that Bug#31072 is fixed."
   (should-error (eval '(defvar 1) t) :type 'wrong-type-argument))
 
+(ert-deftest defvaralias-overwrite-warning ()
+  "Test for Bug#5950."
+  (defvar eval-tests--foo)
+  (setq eval-tests--foo 2)
+  (defvar eval-tests--foo-alias)
+  (setq eval-tests--foo-alias 1)
+  (cl-letf (((symbol-function 'display-warning)
+             (lambda (type &rest _)
+               (throw 'got-warning type))))
+    ;; Warn if we lose a value through aliasing.
+    (should (equal
+             '(defvaralias losing-value eval-tests--foo-alias)
+             (catch 'got-warning
+               (defvaralias 'eval-tests--foo-alias 'eval-tests--foo))))
+    ;; Don't warn if we don't.
+    (makunbound 'eval-tests--foo-alias)
+    (should (eq 'no-warning
+                (catch 'got-warning
+                  (defvaralias 'eval-tests--foo-alias 'eval-tests--foo)
+                  'no-warning)))))
+
 ;;; eval-tests.el ends here