fuzz.lisp

(fiasco:define-test-package :rope/test/fuzz
  (:local-nicknames (#:a #:alexandria)))
(in-package :rope/test/fuzz)

(defvar *charset* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")

(defun random-string (&key (length 128) (acc ""))
  (if (= 0 length)
      acc
      (random-string
       :length (1- length)
       :acc (rope::strcat acc (string (a:random-elt *charset*))))))

(defun random-rope (total-length)
  (with-open-file (source "/dev/urandom" :element-type '(unsigned-byte 8))
    (labels ((read-leaves (&optional acc (acc-length 0))
               (let* ((string* (make-array (min rope::*long-leaf* (- total-length acc-length))
                                           :element-type '(unsigned-byte 8)))
                      (length (read-sequence string* source))
                      (string (map 'string #'code-char string*))
                      (leaf (rope::make-leaf (subseq string 0 length) length)))
                 (if (and (= rope::*long-leaf* length)
                          (not (= total-length (+ length acc-length))))
                     (read-leaves (cons leaf acc) (+ length acc-length))
                     (cons leaf acc)))))
      (let ((leaves (nreverse (read-leaves))))
        (rope::merge-leaves leaves 0 (length leaves))))))

(defgeneric balancedp (rope)
  (:method ((rope rope::leaf))
    t)
  (:method ((rope rope::branch))
    (and (>= 1 (abs (rope::balance-factor rope)))
         (balancedp (rope::branch-left rope))
         (balancedp (rope::branch-right rope)))))

(deftest fuzz-basic-tests ()
  "Run the basic test suite with different leaf sizes."
  (loop :for i :from 1 :to 64
        :do (setf rope::*short-leaf* i)
            (setf rope::*long-leaf* (* 4 i))
            (let ((*standard-output* (make-broadcast-stream)))
              (is (run-tests :rope/test/basic)))))

(deftest fuzz-split ()
  (dotimes (i 1000)
    (let* ((length (random 10000))
           (string (random-string :length length))
           (rope (rope:make-rope string))
           (index (random length)))
      (multiple-value-bind (ante post) (rope:split-rope rope index)
        (is (balancedp ante))
        (is (balancedp post))
        (is (string= (subseq string 0 index) (rope:write-rope ante nil)))
        (is (string= (subseq string index) (rope:write-rope post nil)))))))

(deftest fuzz-index ()
  (dotimes (i 1000)
    (let* ((length (1+ (random 1000)))
           (string (random-string :length length))
           (rope (rope:make-rope string))
           (index (random length)))
      (is (char= (char string index) (rope:index-rope rope index))))))

(deftest fuzz-concat ()
  (dotimes (i 1000)
    (let* ((string-a (random-string :length (random 1000)))
           (string-b (random-string :length (random 1000)))
           (rope-a (rope:make-rope string-a))
           (rope-b (rope:make-rope string-b))
           (new-string (rope::strcat string-a string-b))
           (new-rope (rope:concat-rope rope-a rope-b)))
      (is (balancedp new-rope))
      (is (string= new-string (rope:write-rope new-rope nil))))))

(deftest fuzz-kill ()
  (dotimes (i 1000)
    (let* ((length (+ 10 (random 1000)))
           (string (random-string :length length))
           (rope (rope:make-rope string))
           (end (1+ (random (1- length))))
           (start (random end))
           (new-string (rope::strcat (subseq string 0 start) (subseq string end)))
           (new-rope (rope:kill-rope rope start end)))
      (is (balancedp new-rope))
      (is (string= new-string (rope:write-rope new-rope nil))))))

#+ignore
(deftest fuzz-insert-balance ()
  (setf rope::*long-leaf* 128)
  (dotimes (i 10)
    (let ((rope (random-rope 1000)))
      (dotimes (i 100)
        (setf rope
              (rope:insert-rope rope
                                (random (rope:rope-length rope))
                                (random-string :length (random 512))))
        (unless (balancedp rope)
          (return-from fuzz-insert-balance rope))
        (is (balancedp rope))))))