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