[elpa] externals/compat b27914c0b6 1/2: compat-27: Add ring-resize

[ELPA Syncer]

branch: externals/compat
commit b27914c0b691eb9403e44137e01f6cf5a6c65653
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    compat-27: Add ring-resize
---
 NEWS.org        |  1 +
 compat-27.el    | 24 ++++++++++++++++++++++++
 compat-tests.el | 43 +++++++++++++++++++++++++++++++++++++------
 compat.texi     |  8 ++++++--
 4 files changed, 68 insertions(+), 8 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index eb9171fdde..d1049a7d1b 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -30,6 +30,7 @@
 - compat-27: Add ~fixnump~ and ~bignump~.
 - compat-27: Add ~with-minibuffer-selected-window~.
 - compat-27: Add generalized variables for ~decoded-time-*~.
+- compat-27: Add ~ring-resize~.
 - compat-28: Add ~macroexp-warn-and-return~.
 - compat-28: Add ~subr-native-elisp-p~.
 - compat-28: Add ~bounds-of-thing-at-mouse~.
diff --git a/compat-27.el b/compat-27.el
index 9f9198e07e..16a6b124cd 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -714,5 +714,29 @@ and if a matching region is found, place point at the 
start of the region."
         (and (not (eq ended t))
              ended))))))
 
+;;;; Defined in ring.el
+
+(compat-defun ring-resize (ring size)
+  "Set the size of RING to SIZE.
+If the new size is smaller, then the oldest items in the ring are
+discarded."
+  :feature ring
+  (when (integerp size)
+    (let ((length (ring-length ring))
+          (new-vec (make-vector size nil)))
+      (if (= length 0)
+          (setcdr ring (cons 0 new-vec))
+        (let* ((hd (car ring))
+               (old-size (ring-size ring))
+               (old-vec (cddr ring))
+               (copy-length (min size length))
+               (copy-hd (mod (+ hd (- length copy-length)) length)))
+          (setcdr ring (cons copy-length new-vec))
+          ;; If the ring is wrapped, the existing elements must be written
+          ;; out in the right order.
+          (dotimes (j copy-length)
+            (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size))))
+          (setcar ring 0))))))
+
 (provide 'compat-27)
 ;;; compat-27.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index 1a1b2ddc84..add4f32a79 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -91,7 +91,7 @@
     (should sym)
     (should (symbolp sym))
     (setq list (funcall sym list "first" 1 #'string=))
-    (should (eq (compat-call plist-get list "first" #'string=) 1))))
+    (should-equal (compat-call plist-get list "first" #'string=) 1)))
 
 (defconst compat-tests--version (package-get-version))
 (ert-deftest package-get-version ()
@@ -939,7 +939,7 @@
     (insert "first\nsecond\nthird\n")
     (goto-char 7)
     (delete-line)
-    (should (equal (buffer-string) "first\nthird\n"))))
+    (should-equal (buffer-string) "first\nthird\n")))
 
 (ert-deftest list-of-strings-p ()
   (should-not (list-of-strings-p 1))
@@ -964,16 +964,16 @@
     (setq list (compat-call plist-put list 'first 1))
     (setq list (compat-call plist-put list 'second 2))
     (setq list (compat-call plist-put list 'first 10))
-    (should (eq (compat-call plist-get list 'first) 10))
-    (should (eq (compat-call plist-get list 'second) 2))
+    (should-equal (compat-call plist-get list 'first) 10)
+    (should-equal (compat-call plist-get list 'second) 2)
     (should (compat-call plist-member list 'first))
     (should-not (compat-call plist-member list 'third)))
   (let (list)
     (setq list (compat-call plist-put list "first" 1 #'string=))
     (setq list (compat-call plist-put list "second" 2 #'string=))
     (setq list (compat-call plist-put list "first" 10 #'string=))
-    (should (eq (compat-call plist-get list "first" #'string=) 10))
-    (should (eq (compat-call plist-get list "second" #'string=) 2))
+    (should-equal (compat-call plist-get list "first" #'string=) 10)
+    (should-equal (compat-call plist-get list "second" #'string=) 2)
     (should (compat-call plist-member list "first" #'string=))
     (should-not (compat-call plist-member list "third" #'string=))))
 
@@ -2678,5 +2678,36 @@
   (should-equal "*scratch*" (buffer-name (get-scratch-buffer-create)))
   (should-equal initial-major-mode (buffer-local-value 'major-mode 
(get-scratch-buffer-create))))
 
+(ert-deftest ring-resize ()
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-resize ring 5)
+    (should-equal (ring-size ring) 5)
+    (should-equal (ring-elements ring) '(3 2 1)))
+  (let ((ring (make-ring 3)))
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should-equal (ring-elements ring) '()))
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 5)
+    (should-equal (ring-size ring) 5)
+    (should-equal (ring-elements ring) '(5 4 3)))
+  (let ((ring (make-ring 5)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 3)
+    (should-equal (ring-size ring) 3)
+    (should-equal (ring-elements ring) '(5 4 3))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index ea0e020d00..9668e04ec6 100644
--- a/compat.texi
+++ b/compat.texi
@@ -893,6 +893,12 @@ The function @code{string-version-lessp}.
 The following functions and macros implemented in 27.1, and are provided
 by Compat:
 
+@c copied from lispref/sequences.texi
+@defun ring-resize ring size
+Set the size of @var{ring} to @var{size}.  If the new size is smaller,
+then the oldest items in the ring are discarded.
+@end defun
+
 @c based on lisp/minibuffer.el
 @defmac with-minibuffer-selected-window &rest body
 Execute the forms in @var{body} from the minibuffer in its original
@@ -1414,8 +1420,6 @@ The function @code{file-system-info}.
 @item
 The more consistent treatment of NaN values.
 @item
-The function @code{ring-resize}.
-@item
 The function @code{group-name}.
 @item
 Additional @code{format-spec} modifiers.