master 8fac244: * src/data.c (set_internal): Fix bug#44733

[Stefan Monnier]

branch: master
commit 8fac2444641567b10f4c38b599636aeae0478e68
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * src/data.c (set_internal): Fix bug#44733
    
    Set the default value when `set` encounters a PER_BUFFER variable
    which has been let-bound globally, to match the behavior seen with
    `make-variable-buffer-local`.
    
    * test/src/data-tests.el (binding-test--let-buffer-local):
    Add corresponding test.
    (data-tests--set-default-per-buffer): Add tentative test for the
    performance problem encountered in bug#41029.
---
 src/data.c             | 10 ++++++----
 test/src/data-tests.el | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 56 insertions(+), 4 deletions(-)

diff --git a/src/data.c b/src/data.c
index 6558985..5d4df18 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1440,10 +1440,12 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, 
Lisp_Object where,
          {
            int offset = XBUFFER_OBJFWD (innercontents)->offset;
            int idx = PER_BUFFER_IDX (offset);
-           if (idx > 0
-                && bindflag == SET_INTERNAL_SET
-               && !let_shadows_buffer_binding_p (sym))
-             SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+           if (idx > 0 && bindflag == SET_INTERNAL_SET
+               && !PER_BUFFER_VALUE_P (buf, idx))
+             if (let_shadows_buffer_binding_p (sym))
+               set_default_internal (symbol, newval, bindflag);
+             else
+               SET_PER_BUFFER_VALUE_P (buf, idx, 1);
          }
 
        if (voide)
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ed09203..1312683 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -345,6 +345,25 @@ comparing the subr with a much slower lisp implementation."
       (setq-default binding-test-some-local 'new-default))
     (should (eq binding-test-some-local 'some))))
 
+(ert-deftest data-tests--let-buffer-local ()
+  (let ((blvar (make-symbol "blvar")))
+    (set-default blvar nil)
+    (make-variable-buffer-local blvar)
+
+    (dolist (var (list blvar 'left-margin))
+      (let ((def (default-value var)))
+        (with-temp-buffer
+          (should (equal def (symbol-value var)))
+          (cl-progv (list var) (list 42)
+            (should (equal (symbol-value var) 42))
+            (should (equal (default-value var) (symbol-value var)))
+            (set var 123)
+            (should (equal (symbol-value var) 123))
+            (should (equal (default-value var) (symbol-value var)))) ;bug#44733
+          (should (equal (symbol-value var) def))
+          (should (equal (default-value var) (symbol-value var))))
+        (should (equal (default-value var) def))))))
+
 (ert-deftest binding-test-makunbound ()
   "Tests of makunbound, from the manual."
   (with-current-buffer binding-test-buffer-B
@@ -381,6 +400,37 @@ comparing the subr with a much slower lisp implementation."
   "Test setting a keyword to itself"
   (with-no-warnings (should (setq :keyword :keyword))))
 
+(ert-deftest data-tests--set-default-per-buffer ()
+  :expected-result t ;; Not fixed yet!
+  ;; FIXME: Performance tests are inherently unreliable.
+  ;; Using wall-clock time makes it even worse, so don't bother unless
+  ;; we have the primitive to measure cpu-time.
+  (skip-unless (fboundp 'current-cpu-time))
+  ;; Test performance of set-default on DEFVAR_PER_BUFFER variables.
+  ;; More specifically, test the problem seen in bug#41029 where setting
+  ;; the default value of a variable takes time proportional to the
+  ;; number of buffers.
+  (let* ((fun #'error)
+         (test (lambda ()
+                 (with-temp-buffer
+                   (let ((st (car (current-cpu-time))))
+                     (dotimes (_ 1000)
+                       (let ((case-fold-search 'data-test))
+                         ;; Use an indirection through a mutable var
+                         ;; to try and make sure the byte-compiler
+                         ;; doesn't optimize away the let bindings.
+                         (funcall fun)))
+                     ;; FIXME: Handle the wraparound, if any.
+                     (- (car (current-cpu-time)) st)))))
+         (_ (setq fun #'ignore))
+         (time1 (funcall test))
+         (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
+                       (make-list 1000 nil)))
+         (time2 (funcall test)))
+    (mapc #'kill-buffer bufs)
+    ;; Don't divide one time by the other since they may be 0.
+    (should (< time2 (* time1 5)))))
+
 ;; More tests to write -
 ;; kill-local-variable
 ;; defconst; can modify