# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1618075590 14400
# Node ID 6bf064d46006ab40170d0ad234770d2e2e5d14b3
# Parent  e9553a14c887b4a10f6e8acac716ca2078263398
Add rb-clear and (rb-contents ... :result-type 'vector)

diff -r e9553a14c887 -r 6bf064d46006 src/package.lisp
--- a/src/package.lisp	Fri Apr 09 22:54:39 2021 -0400
+++ b/src/package.lisp	Sat Apr 10 13:26:30 2021 -0400
@@ -203,6 +203,7 @@
 
     :do-ring-buffer
     :make-ring-buffer
+    :rb-clear
     :rb-contents
     :rb-count
     :rb-empty-p
diff -r e9553a14c887 -r 6bf064d46006 src/ring-buffers.lisp
--- a/src/ring-buffers.lisp	Fri Apr 09 22:54:39 2021 -0400
+++ b/src/ring-buffers.lisp	Sat Apr 10 13:26:30 2021 -0400
@@ -31,6 +31,14 @@
        (size ring-buffer)))
 
 
+(defun rb-clear (ring-buffer)
+  "Clear the contents of `ring-buffer`."
+  (fill (data ring-buffer) nil)
+  (setf (r ring-buffer) 0
+        (w ring-buffer) 0)
+  nil)
+
+
 (defmacro 1+mod ((field ring-buffer))
   (once-only (ring-buffer)
     (with-gensyms (result)
@@ -55,7 +63,7 @@
 
 
 (defun rb-push (ring-buffer object)
-  "Push `object` into `ring-buffer`.
+  "Push `object` into `ring-buffer` and return `object`.
 
   If `ring-buffer` is full, its oldest element will be silently dropped.  If you
   want an error to be signaled instead, use `rb-safe-push`.
@@ -140,7 +148,7 @@
 (defun rb-contents (ring-buffer &key (result-type 'list))
   "Return a fresh sequence of the contents of `ring-buffer` (oldest to newest).
 
-  `result-type` can currently only be `list`.  TODO: add `vector`.
+  `result-type` can be `list` or `vector`.
 
   "
   (ecase result-type
@@ -151,7 +159,18 @@
                 :until (= r w)
                 :collect (svref d r)
                 :do (incf r)
-                :when (= r s) :do (setf r 0)))))
+                :when (= r s) :do (setf r 0)))
+    (vector
+      (let* ((n (rb-count ring-buffer))
+             (result (make-array n))
+             (data (data ring-buffer))
+             (r (r ring-buffer))
+             (w (w ring-buffer)))
+        (if (<= r w)
+          (replace result data :start2 r :end2 w)
+          (progn (replace result data :start2 r)
+                 (replace result data :start2 0 :end2 w :start1 (- (size ring-buffer) r))))
+        result))))
 
 
 ;;;; Printing -----------------------------------------------------------------
diff -r e9553a14c887 -r 6bf064d46006 test/base.lisp
--- a/test/base.lisp	Fri Apr 09 22:54:39 2021 -0400
+++ b/test/base.lisp	Sat Apr 10 13:26:30 2021 -0400
@@ -2,7 +2,7 @@
 
 
 (defmacro define-test (name &body body)
-  `(test ,(intern (concatenate 'string (symbol-name 'test-) (symbol-name name)))
+  `(test ,(intern (concatenate 'string (symbol-name 'test/) (symbol-name name)))
     (let ((*package* ,*package*))
       ,@body)))
 
diff -r e9553a14c887 -r 6bf064d46006 test/ring-buffers.lisp
--- a/test/ring-buffers.lisp	Fri Apr 09 22:54:39 2021 -0400
+++ b/test/ring-buffers.lisp	Sat Apr 10 13:26:30 2021 -0400
@@ -1,8 +1,12 @@
 (in-package :losh.test)
 
 (defun check-ring-buffer (rb expected-contents)
-  ;; rb-contents
-  (is (equal expected-contents (rb-contents rb)))
+  ;; rb-contents (list)
+  (is (equal (coerce expected-contents 'list)
+             (rb-contents rb :result-type 'list)))
+  ;; rb-contents (vector)
+  (is (equalp (coerce expected-contents 'vector)
+              (rb-contents rb :result-type 'vector)))
   ;; rb-count
   (is (= (length expected-contents) (rb-count rb)))
   ;; rb-empty
@@ -55,7 +59,13 @@
     (rb-safe-push rb 'c)
     (is (= 4 (rb-size rb)))
     (check-ring-buffer rb '(a b c))
-    (signals error (rb-safe-push rb 'd))))
+    (signals error (rb-safe-push rb 'd))
+
+    (rb-clear rb)
+    (check-ring-buffer rb '())
+
+    (rb-clear rb)
+    (check-ring-buffer rb '())))
 
 (define-test fuzz-ring-buffers
   (do-range ((n 2 30))