~technomancy/fennel

fennel/test/fuzz.fnl -rw-r--r-- 1.9 KiB
59159bb3Phil Hagelberg Remove unneeded else branch in match. 5 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
(local l (require :test.luaunit))
(local fennel (require :fennel))
(local compiler (require :fennel.compiler))
(local generate (require :test.generate))
(local friend (require :fennel.friend))
(local unpack (or table.unpack _G.unpack))

;; extend the generator function to produce ASTs
(table.insert generate.order 4 :sym)
(table.insert generate.order 1 :list)

(local keywords (icollect [k (pairs (doto (fennel.syntax)
                                      (tset :eval-compiler nil)))] k))

(fn generate.generators.sym []
  (fennel.sym (generate.generators.string)))

(fn generate.generators.list [gen depth]
  (let [f (fennel.sym (. keywords (math.random (length keywords))))
        contents (if (< 0.5 (math.random))
                     (generate.generators.sequence gen depth)
                     [])]
    (fennel.list f (unpack contents))))

(local marker {})

(fn fuzz [verbose?]
  (let [code (fennel.view (generate.generators.list generate.generate 1))
        (ok err) (xpcall #(fennel.compile-string code {:useMetadata true
                                                       :compiler-env :strict})
                         #(if (= $ marker)
                              marker
                              (.. (tostring $) "\n" (debug.traceback))))]
    (if verbose?
        (print code)
        (io.write "."))
    (when (not ok)
      ;; if we get an error, it must come from assert-compile; if we get
      ;; a non-assertion error then it must be a compiler bug!
      (l.assertEquals err marker (.. code "\n" (tostring err))))))

(fn test-fuzz []
  (let [verbose? (os.getenv "VERBOSE")
        {: assert-compile : parse-error} friend]
    (math.randomseed (os.time))
    (set friend.assert-compile #(error marker))
    (set friend.parse-error #(error marker))
    (for [_ 1 (tonumber (or (os.getenv "FUZZ_COUNT") 256))]
      (fuzz verbose?))
    (print)
    (set friend.assert-compile assert-compile)
    (set friend.parse-error parse-error)))

{: test-fuzz}