test/circle.lisp @ 14de0f74d3e2

Add a circle data structure

We'll use it for the instruction list soon
author Steve Losh <steve@stevelosh.com>
date Fri, 13 May 2016 20:00:52 +0000
parents (none)
children 5c914fbcb042
(in-package #:bones-test.circle)

(def-suite :bones.circle)
(in-suite :bones.circle)

(defmacro is-circle-contents (circle values)
  `(is (equal ,values
              (circle-to-list ,circle))))


(test empty-circles
  (is-true (circle-empty-p (make-empty-circle)))
  (is-true (circle-empty-p (make-circle-with nil)))
  (is-false (circle-empty-p (make-circle-with (list 1)))))

(test make-circle-with
  (is-circle-contents
    (make-circle-with (list))
    nil)
  (is-circle-contents
    (make-circle-with (list 1 2 3))
    (list 1 2 3))
  (is-circle-contents
    (make-circle-with '(foo))
    (list 'foo))
  (is-circle-contents
    (make-circle-with '((foo)))
    (list (list 'foo))))


(test prepending
  (let ((c (make-empty-circle)))
    (is-circle-contents c nil)

    (circle-prepend c (list 1))
    (is-circle-contents c '(1))

    (circle-prepend c (list 2 3))
    (is-circle-contents c '(2 3 1))

    (circle-prepend c nil)
    (is-circle-contents c '(2 3 1))))

(test appending
  (let ((c (make-empty-circle)))
    (is-circle-contents c nil)

    (circle-append c (list 1))
    (is-circle-contents c '(1))

    (circle-append c (list 2 3))
    (is-circle-contents c '(1 2 3))

    (circle-append c nil)
    (is-circle-contents c '(1 2 3))))

(test appending-and-prepending
  (let ((c (make-empty-circle)))
    (is-circle-contents c nil)

    (circle-append c (list 1))
    (is-circle-contents c '(1))

    (circle-prepend c (list 'a 'b))
    (is-circle-contents c '(a b 1))

    (circle-append c (list 'p 'q))
    (is-circle-contents c '(a b 1 p q))))


(test forward
  (let ((c (make-circle-with (list 1 2 3 4))))
    (is (equal
          '(1 2 3 4)
          (loop :for node = (circle-forward c) :then (circle-forward node)
                :while node
                :collect (circle-value node))))))

(test backward
  (let ((c (make-circle-with (list 1 2 3 4))))
    (is (equal
          '(4 3 2 1)
          (loop :for node = (circle-backward c) :then (circle-backward node)
                :while node
                :collect (circle-value node))))))


(test rotate
  (let ((c (make-circle-with (list 1 2 3 4))))
    (is-circle-contents (circle-rotate c 0)
                        '(1 2 3 4))
    (is-circle-contents (circle-rotate c 1)
                        '(1 2 3 4))
    (is-circle-contents (circle-rotate c 2)
                        '(2 3 4 1))
    (is-circle-contents (circle-rotate c 3)
                        '(3 4 1 2))
    (is-circle-contents (circle-rotate c 4)
                        '(4 1 2 3))
    (is-circle-contents (circle-rotate c 5)
                        '(1 2 3 4))
    (is-circle-contents (circle-rotate c -1)
                        '(4 1 2 3))
    (is-circle-contents (circle-rotate c -2)
                        '(3 4 1 2))
    (is-circle-contents (circle-rotate c -3)
                        '(2 3 4 1))
    (is-circle-contents (circle-rotate c -4)
                        '(1 2 3 4))
    (is-circle-contents (circle-rotate (circle-rotate c 2) 0)
                        '(2 3 4 1))
    (is-circle-contents (circle-rotate (circle-rotate c 2) 1)
                        '(3 4 1 2))
    (is-circle-contents (circle-rotate (circle-rotate c 2) 2)
                        '(4 1 2 3))
    (is-circle-contents (circle-rotate (circle-rotate c 2) -2)
                        '(1 2 3 4))
    (is-circle-contents (circle-rotate (circle-rotate c 3) -1)
                        '(2 3 4 1))))

(test nth
  (let* ((data (list 'a 'b 'c 'd))
         (c (make-circle-with data)))
    (loop :for i :from 0 :below 4
          :for v :in data
          :do (is (eql v (circle-value (circle-nth c i)))))))


(test insert-before
  (let ((c (make-circle-with (list 1 2 3))))
    (circle-insert-before c 'a)
    (is-circle-contents c '(1 2 3 a))

    (circle-insert-before (circle-nth c 0) 'b)
    (is-circle-contents c '(b 1 2 3 a))

    (circle-insert-before (circle-nth c 1) 'c)
    (is-circle-contents c '(b c 1 2 3 a))

    (circle-insert-before (circle-nth c 2) 'd)
    (is-circle-contents c '(b c d 1 2 3 a))

    (circle-insert-before (circle-nth c -1) 'e)
    (is-circle-contents c '(b c d 1 2 3 e a))))

(test insert-after
  (let ((c (make-circle-with (list 1 2 3))))
    (circle-insert-after c 'a)
    (is-circle-contents c '(a 1 2 3))

    (circle-insert-after (circle-nth c 0) 'b)
    (is-circle-contents c '(a b 1 2 3))

    (circle-insert-after (circle-nth c 1) 'c)
    (is-circle-contents c '(a b c 1 2 3))

    (circle-insert-after (circle-nth c 2) 'd)
    (is-circle-contents c '(a b c d 1 2 3))

    (circle-insert-after (circle-nth c -1) 'x)
    (is-circle-contents c '(a b c d 1 2 3 x))))


(test sentinel-p
  (let ((c (make-circle-with (list 1 2 3))))
    (is-true (circle-sentinel-p c))
    (is-false (circle-sentinel-p (circle-nth c 0)))
    (is-false (circle-sentinel-p (circle-nth c 1)))
    (is-false (circle-sentinel-p (circle-nth c 2)))
    (is-true (circle-sentinel-p (circle-nth c 3))))
  (is-true (circle-sentinel-p (make-empty-circle)))
  (is-true (circle-sentinel-p (circle-nth (make-empty-circle) 0)))
  (is-true (circle-sentinel-p (circle-nth (make-empty-circle) -1))))


(test remove
  (let ((c (make-circle-with (list 1 2 3))))
    (signals simple-error (circle-remove c))
    (is-circle-contents c '(1 2 3))

    (circle-remove (circle-nth c 0))
    (is-circle-contents c '(2 3))

    (circle-remove (circle-nth c 1))
    (is-circle-contents c '(2))

    (circle-remove (circle-nth c 0))
    (is-circle-contents c '())))

(test backward-remove
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-backward-remove (circle-nth c 1))
                        '(1 3 4 5 6))

    (is-false (circle-backward-remove (circle-nth c 0)))
    (is-circle-contents c '(3 4 5 6))

    (is-circle-contents (circle-backward-remove (circle-nth c -1))
                        '(5 3 4))

    (is-circle-contents c '(3 4 5))))

(test forward-remove
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-forward-remove (circle-nth c 1))
                        '(3 4 5 6 1))

    (is-false (circle-forward-remove (circle-nth c -1)))
    (is-circle-contents c '(1 3 4 5))))


(test replace
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (circle-replace (circle-nth c 0) 'foo)
    (is-circle-contents c '(foo 2 3 4 5 6))

    (circle-replace (circle-nth c 0) 'bar)
    (is-circle-contents c '(bar 2 3 4 5 6))

    (circle-replace (circle-nth c 1) 'a)
    (is-circle-contents c '(bar a 3 4 5 6))

    (circle-replace (circle-nth c 2) 'b)
    (is-circle-contents c '(bar a b 4 5 6))

    (circle-replace (circle-nth c -1) 'c)
    (is-circle-contents c '(bar a b 4 5 c))))

(test backward-replace
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-backward-replace (circle-nth c 1) 'foo)
                        '(1 foo 3 4 5 6))

    (is-circle-contents (circle-backward-replace (circle-nth c 1) 'bar)
                        '(1 bar 3 4 5 6))

    (is-circle-contents (circle-backward-replace (circle-nth c 2) 'a)
                        '(bar a 4 5 6 1))

    (is-false (circle-backward-replace (circle-nth c 0) 'dogs))
    (is-circle-contents c '(dogs bar a 4 5 6))))

(test forward-replace
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-forward-replace (circle-nth c 1) 'foo)
                        '(3 4 5 6 1 foo))

    (is-circle-contents (circle-forward-replace (circle-nth c 1) 'bar)
                        '(3 4 5 6 1 bar))

    (is-false (circle-forward-replace (circle-nth c -1) 'cats))
    (is-circle-contents c '(1 bar 3 4 5 cats))))


(test splice
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (circle-splice (circle-nth c 0) (list 'a 'b))
    (is-circle-contents c '(a b 2 3 4 5 6))

    (circle-splice (circle-nth c 1) (list 'c))
    (is-circle-contents c '(a c 2 3 4 5 6))

    (circle-splice (circle-nth c -1) (list 'dogs 'cats))
    (is-circle-contents c '(a c 2 3 4 5 dogs cats))

    (circle-splice (circle-nth c 3) nil)
    (is-circle-contents c '(a c 2 4 5 dogs cats))))

(test backward-splice
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-backward-splice (circle-nth c 2) '(a b))
                        '(2 a b 4 5 6 1))

    (is-circle-contents (circle-backward-splice (circle-nth c -1) '())
                        '(5 1 2 a b 4))

    (is-false (circle-backward-splice (circle-nth c 0) '(first second)))
    (is-circle-contents c '(first second 2 a b 4 5))))

(test forward-splice
  (let ((c (make-circle-with (list 1 2 3 4 5 6))))
    (is-circle-contents c '(1 2 3 4 5 6))

    (is-circle-contents (circle-forward-splice (circle-nth c 0) '(a b))
                        '(2 3 4 5 6 a b))

    (is-circle-contents (circle-forward-splice (circle-nth c 1) '())
                        '(2 3 4 5 6 a))

    (is-false (circle-forward-splice (circle-nth c -1) '(last)))
    (is-circle-contents c '(a 2 3 4 5 last))))