Very much better! Generating tests for n-arg functions which are ninety
percent correct (five failures in 775 assertions).
This commit is contained in:
parent
0125723c83
commit
61b6983294
|
@ -4,20 +4,34 @@
|
||||||
clojure.math.combinatorics))
|
clojure.math.combinatorics))
|
||||||
|
|
||||||
|
|
||||||
(defn maybe-quote [val]
|
(defn maybe-quote
|
||||||
"Convert val into a form in which, after being passed through the pretty
|
"Convert val into a form in which, after being passed through the pretty
|
||||||
printer, it will be reconstituted in a form useful to the test"
|
printer, it will be reconstituted in a form useful to the test"
|
||||||
|
[val]
|
||||||
|
(let [mval (try
|
||||||
|
(macroexpand val)
|
||||||
|
(catch Exception any val))]
|
||||||
(cond
|
(cond
|
||||||
|
(= true val) true
|
||||||
|
(nil? val) nil
|
||||||
|
(number? val) val
|
||||||
|
(string? val) val
|
||||||
|
(keyword? val) val
|
||||||
|
(vector? val) val
|
||||||
|
(map? val) val
|
||||||
(symbol? val) (list 'symbol (str val))
|
(symbol? val) (list 'symbol (str val))
|
||||||
true (list 'quote val)))
|
(and (seq mval) (= (first mval) 'quote)) val
|
||||||
|
true (list 'quote val))))
|
||||||
|
|
||||||
(defn generate-assertion [fnname args]
|
(defn generate-assertion
|
||||||
"Generate an appropiate assertion for these arguments passed to this function"
|
"Generate an appropiate assertion for these arguments passed to this function"
|
||||||
(print (str "Generating assertion for " (cons fnname args)))
|
[fnname args]
|
||||||
|
(let [doc-string (str "Generating assertion for " (cons fnname args))]
|
||||||
(try
|
(try
|
||||||
(let [val (eval (cons fnname args))]
|
(let [val (eval (cons fnname args))]
|
||||||
(list 'is (list '= (cons fnname args) (maybe-quote val))))
|
(list 'is (list '= (cons fnname args) (maybe-quote val)) doc-string))
|
||||||
(catch Exception e (list 'is (list 'thrown? (.getClass e) (cons fnname args))))))
|
(catch Exception e
|
||||||
|
(list 'is (list 'thrown? (.getClass e) (cons fnname args)))))))
|
||||||
|
|
||||||
(defn constant? [arg]
|
(defn constant? [arg]
|
||||||
(not (or
|
(not (or
|
||||||
|
@ -36,6 +50,8 @@
|
||||||
|
|
||||||
(defn find-interesting-args [sexpr extra-vars]
|
(defn find-interesting-args [sexpr extra-vars]
|
||||||
"Find things in sexpr which would be even more interesting if passed as arguments to it"
|
"Find things in sexpr which would be even more interesting if passed as arguments to it"
|
||||||
|
(apply list
|
||||||
|
(set
|
||||||
(concat generic-args extra-vars
|
(concat generic-args extra-vars
|
||||||
(flatten
|
(flatten
|
||||||
(map
|
(map
|
||||||
|
@ -43,7 +59,7 @@
|
||||||
(integer? %) (list % (inc %) (dec %))
|
(integer? %) (list % (inc %) (dec %))
|
||||||
(number? %) (list % (+ % 0.0001) (- % 0.0001))
|
(number? %) (list % (+ % 0.0001) (- % 0.0001))
|
||||||
true %)
|
true %)
|
||||||
(constants sexpr)))))
|
(constants sexpr)))))))
|
||||||
|
|
||||||
|
|
||||||
(defn n-of [arg n]
|
(defn n-of [arg n]
|
||||||
|
@ -55,28 +71,34 @@
|
||||||
|
|
||||||
;; This version of generate-test tries to generate good tests for functions of one
|
;; This version of generate-test tries to generate good tests for functions of one
|
||||||
;; argument. It works.
|
;; argument. It works.
|
||||||
;; (defn generate-test [fndef extra-vars]
|
(defn generate-test-1 [fndef extra-vars]
|
||||||
;; "Generate a test for this function definition"
|
|
||||||
;; (cond (or (= (first fndef) 'def)(= (first fndef) 'defn))
|
|
||||||
;; (let [name (first (rest fndef))
|
|
||||||
;; potential-args (find-interesting-args fndef extra-vars)]
|
|
||||||
;; (list 'deftest (symbol (str "test-" name))
|
|
||||||
;; (concat (list 'testing (str name))
|
|
||||||
;; (map #(generate-assertion name (list %)) potential-args))))))
|
|
||||||
|
|
||||||
;; This version of generate-test tries to generate good tests for functions of one or more than one
|
|
||||||
;; argument. Unfortunately, it is borked.
|
|
||||||
(defn generate-test [fndef extra-vars]
|
|
||||||
"Generate a test for this function definition"
|
"Generate a test for this function definition"
|
||||||
(cond (or (= (first fndef) 'def)(= (first fndef) 'defn))
|
(cond (or (= (first fndef) 'def)(= (first fndef) 'defn))
|
||||||
(let [name (first (rest fndef))
|
(let [name (first (rest fndef))
|
||||||
potential-args (find-interesting-args fndef extra-vars)]
|
potential-args (find-interesting-args fndef extra-vars)]
|
||||||
|
(list 'deftest (symbol (str "test-" name))
|
||||||
|
(concat (list 'testing (str name))
|
||||||
|
(map #(generate-assertion name (list %)) potential-args))))))
|
||||||
|
|
||||||
|
;; This version of generate-test tries to generate good tests for functions of one or more than one
|
||||||
|
;; argument. Unfortunately, it is borked.
|
||||||
|
(defn generate-test-n [fndef extra-vars]
|
||||||
|
"Generate a test for this function definition"
|
||||||
|
(cond (or (= (first fndef) 'def)(= (first fndef) 'defn))
|
||||||
|
(let [name (first (rest fndef))
|
||||||
|
arg-list (nth fndef 2)
|
||||||
|
potential-args (map maybe-quote (find-interesting-args fndef extra-vars))]
|
||||||
|
(print potential-args)
|
||||||
(try
|
(try
|
||||||
(list 'deftest (symbol (str "test-" name))
|
(list 'deftest (symbol (str "test-" name))
|
||||||
(concat (list 'testing (str name))
|
(concat (list 'testing (str name))
|
||||||
(map #(generate-assertion name %)
|
(map #(generate-assertion name %)
|
||||||
(cond (vector? (nth fndef 2)) (apply cartesian-product (n-of potential-args (count (nth fndef 2))))
|
(cond
|
||||||
true (map #(list %) potential-args)))))
|
(vector? arg-list)
|
||||||
|
(apply cartesian-product
|
||||||
|
(n-of potential-args (count arg-list)))
|
||||||
|
true
|
||||||
|
(map #(list %) potential-args)))))
|
||||||
(catch Exception any)))))
|
(catch Exception any)))))
|
||||||
|
|
||||||
;; generating a test file
|
;; generating a test file
|
||||||
|
@ -135,7 +157,7 @@
|
||||||
(defn generate-tests [filename]
|
(defn generate-tests [filename]
|
||||||
"Generate a suite of characterisation tests for the file indicated by this filename.
|
"Generate a suite of characterisation tests for the file indicated by this filename.
|
||||||
|
|
||||||
filename: the file path name of a file containing Clojure code to be tested."
|
* `filename`: the file path name of a file containing Clojure code to be tested."
|
||||||
(let [fn (clean-filename filename)
|
(let [fn (clean-filename filename)
|
||||||
pn (packagename-from-filename filename)
|
pn (packagename-from-filename filename)
|
||||||
extra-vars (find-vars-in-file filename)]
|
extra-vars (find-vars-in-file filename)]
|
||||||
|
@ -150,12 +172,16 @@
|
||||||
(while (.ready eddi)
|
(while (.ready eddi)
|
||||||
(println "reading...")
|
(println "reading...")
|
||||||
(let [form (read eddi false nil)]
|
(let [form (read eddi false nil)]
|
||||||
|
(try
|
||||||
(cond (= (first form) 'defn)
|
(cond (= (first form) 'defn)
|
||||||
(do
|
(do
|
||||||
(println (first (rest form)) "...")
|
(println (first (rest form)) "...")
|
||||||
(pprint (generate-test form extra-vars) dickens)
|
(pprint (generate-test-n form extra-vars) dickens)
|
||||||
(.write dickens "\n\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")
|
(.write dickens "\n\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")
|
||||||
))))
|
))
|
||||||
|
(catch Exception any
|
||||||
|
(.write dickens
|
||||||
|
"\n\n;; ERROR while attempting to generate\n\n")))))
|
||||||
(.write dickens "\n\n;; end of file ;;\n\n")
|
(.write dickens "\n\n;; end of file ;;\n\n")
|
||||||
(.flush dickens))))
|
(.flush dickens))))
|
||||||
|
|
||||||
|
|
File diff suppressed because it is too large
Load diff
58
test/testgen/manual_test.clj
Normal file
58
test/testgen/manual_test.clj
Normal file
|
@ -0,0 +1,58 @@
|
||||||
|
(ns testgen.manual_test
|
||||||
|
(:require [clojure.test :refer :all]
|
||||||
|
[testgen.core :refer :all]))
|
||||||
|
|
||||||
|
(deftest find-interesting-args-test
|
||||||
|
(testing "find-interesting-args"
|
||||||
|
(let [args (find-interesting-args
|
||||||
|
'(defn find-interesting-args [sexpr extra-vars]
|
||||||
|
"Find things in sexpr which would be even more interesting if passed as arguments to it"
|
||||||
|
(concat generic-args extra-vars
|
||||||
|
(flatten
|
||||||
|
(map
|
||||||
|
#(cond
|
||||||
|
(integer? %) (list % (inc %) (dec %))
|
||||||
|
(number? %) (list % (+ % 0.0001) (- % 0.0001))
|
||||||
|
true %)
|
||||||
|
(constants sexpr))))) nil)]
|
||||||
|
(is (= args '(nil
|
||||||
|
0
|
||||||
|
0.0
|
||||||
|
()
|
||||||
|
"Find things in sexpr which would be even more interesting if passed as arguments to it"
|
||||||
|
(quote (a :b "c"))
|
||||||
|
:test
|
||||||
|
true
|
||||||
|
1.0E-4
|
||||||
|
2.0E-4
|
||||||
|
"test"))
|
||||||
|
"Fix: I ran it, and this is what it produced")
|
||||||
|
(is (= (find-interesting-args nil nil)
|
||||||
|
'(nil 0 () (quote (a :b "c")) :test true "test"))
|
||||||
|
"Fix: I ran it, and this is what it produced"))))
|
||||||
|
|
||||||
|
(deftest n-of-test
|
||||||
|
(testing "n-of"
|
||||||
|
(is (nil? (n-of true 0)) "Zero of anything should be nil")
|
||||||
|
(is (nil? (n-of nil 0)) "Zero of anything should be nil")
|
||||||
|
(is (nil? (n-of 4 0)) "Zero of anything should be nil")
|
||||||
|
(is (nil? (n-of '(a) 0)) "Zero of anything should be nil")
|
||||||
|
(is (nil? (n-of "a" 0)) "Zero of anything should be nil")
|
||||||
|
(is (empty?
|
||||||
|
(remove true?
|
||||||
|
(map
|
||||||
|
#(let [result (n-of % 4)]
|
||||||
|
(is (= (count result) 4)
|
||||||
|
"4 of anything should be 4")
|
||||||
|
(is (= (first result) %)
|
||||||
|
"the first of four of anything should be that thing"))
|
||||||
|
generic-args))))))
|
||||||
|
|
||||||
|
(deftest generate-assertion-test
|
||||||
|
(testing "generate-assertion"
|
||||||
|
(is (= (generate-assertion '+ '( 1 2))
|
||||||
|
'(is (= (+ 1 2) 3) "Generating assertion for (+ 1 2)"))
|
||||||
|
"This is what we're aiming for")))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue