A fuzzer for Scheme compilers/interpreters that generates test programs via macros.

gistfile1.scm

;; Fuzzer configuration
;; A good seed for crashing during code generation: 1343186061
(define seed (current-time)) ; current-time is Guile-specific (RNG seed)
(define max-items 10000) ; Maximum number of list elements in the output program
(define max-int (expt 2 30)) ; Largest int to appear in any math expression
(define branch-factor 100) ; Most arguments to a math expression

;; Random number generator - Numerical Recipes LCG
(define (rand-int mod)
  (let ((a 1664525)
        (c 1013904223))
    (set! seed (modulo (+ (* a seed) c)
                       (expt 2 32))))
  (modulo seed mod))

(define (rand-range min max) (+ min (rand-int (+ 1 (- max min)))))
(define (rand-bool) (> (rand-int 2) 0))
(define (rand-% percent)
  (> (rand-int 100) percent))

;; tail-recursive helper for tabulate below
(define (tab* f n tail)
  (if (<= n 0)
      tail
      (tab* f (- n 1) (cons (f n) tail))))

;; (tabulate f n) ==> `((f 0) (f 1) ... (f (- n 1)))
(define (tabulate f n) (tab* f n `()))

(define (ignore f) (lambda (x) (f)))

;; Constant data
;; Chars legal in non-initial position of an identifier
(define ident-chars (string->list "+-.*/<=>!?:$%_&~^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
;; In initial position of identifier
(define init-chars (string->list "/<=>!?:$%_&~^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
;; n-ary arithmetic operators with their minimum number of args
(define ariths '((+ 0) (- 1) (* 0) (/ 1)))

;; Return nth element of list if n >= 0, car otherwise
(define (nth list n)
  (if (<= n 0)
      (car list)
      (nth (cdr list) (- n 1))))

;; Make a list of n applications of f to arg. Mostly useful for
;; stateful stuff, like RNGs
(define (apply-n n f arg)
  (let ((g (lambda (x) (f arg))))
    (tabulate g n)))

;; Return a random element of list
(define (rand-elem list)
  (nth list (rand-int (length list))))

;; Assume positive len, generate random identifier
(define (rand-ident len)
  (list->string
   (cons (rand-elem init-chars)
         (apply-n (- len 1) rand-elem ident-chars))))

(define items-left max-items)

(define (arith-arg)
  (set! items-left (- items-left 1))
  (if (rand-% 70)
      (rand-int max-int)
      (rand-arith)))

(define (rand-arith)
  (if (<= items-left 0)
      1 ; Out of operations - stick in a constant expression
      (let ((op (rand-elem ariths)))
        (cons (car op)
              (tabulate (ignore arith-arg)
                        (rand-range (cadr op) branch-factor))))))

;; An arbitrary arithmetic function for fun
(define (double n) (* 2 n))

;; Generate an addition involving n numbers
(define-macro (fuzz1 n)
    (cons '+ (tabulate double n)))

(define-macro (fuzz2)
  (rand-arith))

;; This crashes guile 2.0.5-deb+1-1, even though it can easily
;; generate lists this big at runtime. However, it can neither
;; expand the macro this far or compile a file containing the
;; macro's output.
;(fuzz 10000)

;; And even better, this one crashes with a segfault while generating code.
;(rand-arith)