changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/lib/rt/fuzz.lisp

revision 632: bbd9024f2fe2
parent 631: 0b82a2893d26
child 633: 88a3f078c185
     1.1--- a/lisp/lib/rt/fuzz.lisp	Fri Aug 30 21:29:55 2024 -0400
     1.2+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3@@ -1,51 +0,0 @@
     1.4-;;; fuzz.lisp --- RT Fuzz
     1.5-
     1.6-;; FUZZER API
     1.7-
     1.8-;;; Commentary:
     1.9-
    1.10-;; 
    1.11-;; wiki: https://en.wikipedia.org/wiki/Fuzzing
    1.12-
    1.13-;;; Code:
    1.14-(in-package :rt/fuzz)
    1.15-
    1.16-(defvar *default-fuzz-generator*
    1.17-  (lambda (state)
    1.18-    (random most-positive-fixnum state)))
    1.19-
    1.20-(defclass fuzzer ()
    1.21-  ((state :initform (make-random-state t)
    1.22-    :initarg :state
    1.23-          :accessor fuzz-state)
    1.24-   (generator :initform *default-fuzz-generator*
    1.25-              :initarg :generator
    1.26-              :type function
    1.27-              :accessor fuzz-generator))
    1.28-  (:documentation "An object which provides invalid, unexpected or random data as inputs to some
    1.29-program."))
    1.30-
    1.31-(defgeneric fuzz (self &key &allow-other-keys)
    1.32-  (:method ((self fuzzer) &key &allow-other-keys)
    1.33-    (funcall (the function (fuzz-generator self)) (fuzz-state self)))
    1.34-  (:method ((self fuzzer) &key count)
    1.35-    (if count
    1.36-        (let ((ret))
    1.37-          (dotimes (i count ret)
    1.38-            (push (funcall (the function (fuzz-generator self)) (fuzz-state self)) ret)))
    1.39-        (fuzz self))))
    1.40-
    1.41-(defgeneric fuzz* (state generator &key &allow-other-keys)
    1.42-  (:method ((state list) (generator function) &key (count 1))
    1.43-    (let ((ret))
    1.44-      (dotimes (i count ret)
    1.45-        (push (funcall generator state) ret))))
    1.46-  (:method ((state vector) (generator function) &key (count 1))
    1.47-    (let ((ret (make-array count :fill-pointer 0)))
    1.48-      (dotimes (i count ret)
    1.49-        (setf (aref ret i) (funcall generator state)))))
    1.50-  (:method ((state hash-table) (generator function) &key (count 1))
    1.51-    (let ((ret (make-hash-table)))
    1.52-      (dotimes (i count ret)
    1.53-        (destructuring-bind (k v) (funcall generator state)
    1.54-          (setf (gethash k ret) v))))))