1 files changed, 156 insertions, 0 deletions

diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el
new file mode 100644
index 00000000000..ed35477cafd
--- /dev/null
+++ b/test/lisp/emacs-lisp/track-changes-tests.el
@@ -0,0 +1,156 @@
+;;; track-changes-tests.el --- tests for emacs-lisp/track-changes.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2024  Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'track-changes)
+(require 'cl-lib)
+(require 'ert)
+
+(defun track-changes-tests--random-word ()
+  (let ((chars ()))
+    (dotimes (_ (1+ (random 12)))
+      (push (+ ?A (random (1+ (- ?z ?A)))) chars))
+    (apply #'string chars)))
+
+(defvar track-changes-tests--random-verbose nil)
+
+(defun track-changes-tests--message (&rest args)
+  (when track-changes-tests--random-verbose (apply #'message args)))
+
+(defvar track-changes-tests--random-seed
+  (let ((seed (number-to-string (random (expt 2 24)))))
+    (message "Random seed = %S" seed)
+    seed))
+
+(ert-deftest track-changes-tests--random ()
+  ;; Keep 2 buffers in sync with a third one as we make random
+  ;; changes to that 3rd one.
+  ;; We have 3 trackers: a "normal" one which we sync
+  ;; at random intervals, one which syncs via the "disjoint" signal,
+  ;; plus a third one which verifies that "nobefore" gets
+  ;; information consistent with the "normal" tracker.
+  (with-temp-buffer
+    (random track-changes-tests--random-seed)
+    (dotimes (_ 100)
+      (insert (track-changes-tests--random-word) "\n"))
+    (let* ((buf1 (generate-new-buffer " *tc1*"))
+           (buf2 (generate-new-buffer " *tc2*"))
+           (char-counts (make-vector 2 0))
+           (sync-counts (make-vector 2 0))
+           (print-escape-newlines t)
+           (file (make-temp-file "tc"))
+           (id1 (track-changes-register #'ignore))
+           (id3 (track-changes-register #'ignore :nobefore t))
+           (sync
+            (lambda (id buf n)
+              (track-changes-tests--message "!! SYNC %d !!" n)
+              (track-changes-fetch
+               id (lambda (beg end before)
+                    (when (eq n 1)
+                      (track-changes-fetch
+                       id3 (lambda (beg3 end3 before3)
+                             (should (eq beg3 beg))
+                             (should (eq end3 end))
+                             (should (eq before3
+                                         (if (symbolp before)
+                                             before (length before)))))))
+                    (cl-incf (aref sync-counts (1- n)))
+                    (cl-incf (aref char-counts (1- n)) (- end beg))
+                    (let ((after (buffer-substring beg end)))
+                      (track-changes-tests--message
+                       "Sync:\n    %S\n=>  %S\nat %d .. %d"
+                       before after beg end)
+                      (with-current-buffer buf
+                        (if (eq before 'error)
+                            (erase-buffer)
+                          (should (equal before
+                                         (buffer-substring
+                                          beg (+ beg (length before)))))
+                          (delete-region beg (+ beg (length before))))
+                        (goto-char beg)
+                        (insert after)))
+                    (should (equal (buffer-string)
+                                   (with-current-buffer buf
+                                     (buffer-string))))))))
+           (id2 (track-changes-register
+                 (lambda (id2 &optional distance)
+                   (when distance
+                     (track-changes-tests--message "Disjoint distance: %d"
+                                                   distance)
+                     (funcall sync id2 buf2 2)))
+                 :disjoint t)))
+      (write-region (point-min) (point-max) file)
+      (insert-into-buffer buf1)
+      (insert-into-buffer buf2)
+      (should (equal (buffer-hash) (buffer-hash buf1)))
+      (should (equal (buffer-hash) (buffer-hash buf2)))
+      (message "seeding with: %S" track-changes-tests--random-seed)
+      (dotimes (_ 1000)
+        (pcase (random 15)
+          (0
+           (track-changes-tests--message "Manual sync1")
+           (funcall sync id1 buf1 1))
+          (1
+           (track-changes-tests--message "Manual sync2")
+           (funcall sync id2 buf2 2))
+          ((pred (< _ 5))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 100))) (point-max))))
+             (track-changes-tests--message "Fill %d .. %d" beg end)
+             (fill-region-as-paragraph beg end)))
+          ((pred (< _ 8))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 12))) (point-max))))
+             (track-changes-tests--message "Delete %S at %d .. %d"
+                                           (buffer-substring beg end) beg end)
+             (delete-region beg end)))
+          ((and 8 (guard (= (random 50) 0)))
+           (track-changes-tests--message "Silent insertion")
+           (let ((inhibit-modification-hooks t))
+             (insert "a")))
+          ((and 8 (guard (= (random 10) 0)))
+           (track-changes-tests--message "Revert")
+           (insert-file-contents file nil nil nil 'replace))
+          ((and 8 (guard (= (random 3) 0)))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 12))) (point-max)))
+                  (after (eq (random 2) 0)))
+             (track-changes-tests--message "Bogus %S %d .. %d"
+                                           (if after 'after 'before) beg end)
+             (if after
+                 (run-hook-with-args 'after-change-functions
+                                     beg end (- end beg))
+               (run-hook-with-args 'before-change-functions beg end))))
+          (_
+           (goto-char (+ (point-min) (random (1+ (buffer-size)))))
+           (let ((word (track-changes-tests--random-word)))
+             (track-changes-tests--message "insert %S at %d" word (point))
+             (insert  word "\n")))))
+      (message "SCOREs: default: %d/%d=%d     disjoint: %d/%d=%d"
+               (aref char-counts 0) (aref sync-counts 0)
+               (/ (aref char-counts 0) (aref sync-counts 0))
+               (aref char-counts 1) (aref sync-counts 1)
+               (/ (aref char-counts 1) (aref sync-counts 1))))))
+
+
+
+;;; track-changes-tests.el ends here