Now reads clojure source from a file, and emits tests to another file.

Definitely has many inellegances, but is currently generating and passing tests on itself: Ran 7 tests containing 114 assertions. 0 failures, 0 errors.
2014-04-03 23:22:24 +01:00 · 2014-04-03 23:22:24 +01:00 · 0400b3fa4b
parent f4f114b12e
commit 0400b3fa4b
3 changed files with 453 additions and 72 deletions
--- a/README.md
+++ b/README.md
@ -14,35 +14,43 @@ When modifying a corpus of legacy code, one wants to make only the desired chang

 At this stage, try

-    (testgen <function-source>)
+    (generate-tests <filename>)

-It will attempt to generate as Clojure source a set of clojure.test test definitions
+It will attempt to read function definitions from the indicated file and generate as Clojure source a set of clojure.test test definitions
 for the code passed. For example:

-    user=> (pprint (testgen '(defn testgen [fndef]
-      #_=> (cond (= (first fndef) 'defn)
-      #_=> (let [name (first (rest fndef))]
-      #_=> (list 'deftest (symbol (str "test-" name))
-      #_=> (map #(write-test name %) (find-interesting-args fndef))))))
-      #_=> )
-      #_=> )
    (deftest
-     test-testgen
-     ((is (= (testgen nil) nil))
-      (is (= (testgen ()) nil))
-      (is (thrown? java.lang.IllegalArgumentException (testgen true)))
-      (is (= (testgen "test") nil))
-      (is (thrown? java.lang.IllegalArgumentException (testgen :test)))
-      (is (thrown? java.lang.IllegalArgumentException (testgen 0)))
-      (is
-       (thrown?
-        java.lang.IllegalArgumentException
-        (testgen Integer/MAX_VALUE)))
-      (is (thrown? java.lang.IllegalArgumentException (testgen 1.0E-4)))
-      (is (thrown? java.lang.IllegalArgumentException (testgen -1.0E-4)))
-      (is (= (testgen "test-") nil))))
+     test-write-test
+     (is (thrown? clojure.lang.ArityException (write-test nil)))
+     (is (thrown? clojure.lang.ArityException (write-test ())))
+     (is (thrown? clojure.lang.ArityException (write-test '(a :b "c"))))
+     (is (thrown? clojure.lang.ArityException (write-test true)))
+     (is (thrown? clojure.lang.ArityException (write-test "test")))
+     (is (thrown? clojure.lang.ArityException (write-test :test)))
+     (is (thrown? clojure.lang.ArityException (write-test 0)))
+     (is
+      (thrown? clojure.lang.ArityException (write-test Integer/MAX_VALUE)))
+     (is (thrown? clojure.lang.ArityException (write-test 22/7)))
+     (is (thrown? clojure.lang.ArityException (write-test 1.0E-4)))
+     (is (thrown? clojure.lang.ArityException (write-test -1.0E-4))))
+    (deftest
+     test-constant?
+     (is (= (constant? nil) 'true))
+     (is (= (constant? ()) 'false))
+     (is (= (constant? '(a :b "c")) 'false))
+     (is (= (constant? true) 'true))
+     (is (= (constant? "test") 'true))
+     (is (= (constant? :test) 'true))
+     (is (= (constant? 0) 'true))
+     (is (= (constant? Integer/MAX_VALUE) 'true))
+     (is (= (constant? 22/7) 'true))
+     (is (= (constant? 1.0E-4) 'true))
+     (is (= (constant? -1.0E-4) 'true)))

-Note, however, that it only works if the function for which tests are being generated already exists in the environment.
+
+Note, however, that it only works if the function for which tests are being generated already exists in the environment, so for now you have to 'use' the file first.
+
+Note also that it only generates meaningful tests - thus far - for functions of one argument.

 ## Where this is going

--- a/src/testgen/core.clj
+++ b/src/testgen/core.clj
@ -1,9 +1,11 @@
-(ns testgen.core)
+(ns testgen.core
+  (:use clojure.java.io
+        clojure.pprint))

-(defn write-test [fnname arg] 
+(defn write-test [fnname arg]
     (try
     	(list 'is (list '= (list fnname arg) (list 'quote (eval (list fnname arg)))))
-	(catch Exception e (list 'is (list 'thrown? (.getClass e) (list fnname arg))))))
+	    (catch Exception e (list 'is (list 'thrown? (.getClass e) (list fnname arg))))))


 (defn constant? [arg]
@ -22,16 +24,16 @@
 (defn find-interesting-args [sexpr]
 	"Find things in sexpr which would be even more interesting if passed as arguments to it"
 	(concat generic-args
-		(flatten 
-			(map 
-				#(cond 
-					(integer? %) (list % (inc %) (dec %)) 
+		(flatten
+			(map
+				#(cond
+					(integer? %) (list % (inc %) (dec %))
 					(number? %) (list % (+ % 0.0001) (- % 0.0001))
-					true %) 
+					true %)
 				(constants sexpr)))))

-(defn testgen [fndef] 
-	(cond (= (first fndef) 'defn)
+(defn testgen [fndef]
+	(cond (or (= (first fndef) 'def)(= (first fndef) 'defn))
 		(let [name (first (rest fndef))]
 			(concat (list 'deftest (symbol (str "test-" name)))
 				(map #(write-test name %) (find-interesting-args fndef))))))
@ -39,4 +41,33 @@
 ;; (defn gen-tests [fnname form]
 ;;   (map (partial write-test fnname) (constants form)))

+(defn clean-filename [filename]
+  "remove the trailing '.clj' from a Clojure file name"
+  (cond
+   (.endsWith filename ".clj") (.substring filename 0 (- (count filename) 4))
+   true filename))

+(defn packagename-from-filename [filename]
+  "Return, as a symbol, the package name associated with this filename. There's
+  probably a better way of doing this."
+  (let [fn (clean-filename filename)]
+    (symbol (.replace fn "/" "."))))
+
+
+(defn generate-tests [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."
+  (try
+    (let [fn (clean-filename filename)
+          pn (packagename-from-filename filename)]
+      ;; load the file so that any functions in it are usable
+      ;; (load fn)
+      ;; (refer pn)
+      (with-open [eddie (java.io.PushbackReader. (reader filename))
+                  dickens (writer "output")]
+          (while (.ready eddie)
+            (let [form (macroexpand (read eddie))]
+              (cond (= (first form) 'def)
+                (pprint (testgen form) dickens))))))
+    (catch Exception eof)))
--- a/test/testgen/core_test.clj
+++ b/test/testgen/core_test.clj
@ -4,42 +4,20 @@
  (:require [clojure.test :refer :all]
            [testgen.core :refer :all]))

-
-
 (deftest
- test-integer?
- (is (= (integer? nil) false))
- (is (= (integer? ()) false))
- (is (= (integer? '(a :b "c")) false))
- (is (= (integer? true) false))
- (is (= (integer? "test") false))
- (is (= (integer? :test) false))
- (is (= (integer? 0) true))
- (is (= (integer? Integer/MAX_VALUE) true))
- (is (= (integer? 22/7) false))
- (is (= (integer? 1.0E-4) false))
- (is (= (integer? -1.0E-4) false))
- (is (= (integer? "Returns true if n is an integer") false)))
-
-
-(deftest
- test-testgen
- (is (= (testgen nil) nil))
- (is (= (testgen ()) nil))
- (is (= (testgen '(a :b "c")) nil))
- (is (thrown? java.lang.IllegalArgumentException (testgen true)))
- (is (= (testgen "test") nil))
- (is (thrown? java.lang.IllegalArgumentException (testgen :test)))
- (is (thrown? java.lang.IllegalArgumentException (testgen 0)))
+ test-write-test
+ (is (thrown? clojure.lang.ArityException (write-test nil)))
+ (is (thrown? clojure.lang.ArityException (write-test ())))
+ (is (thrown? clojure.lang.ArityException (write-test '(a :b "c"))))
+ (is (thrown? clojure.lang.ArityException (write-test true)))
+ (is (thrown? clojure.lang.ArityException (write-test "test")))
+ (is (thrown? clojure.lang.ArityException (write-test :test)))
+ (is (thrown? clojure.lang.ArityException (write-test 0)))
 (is
-  (thrown?
-   java.lang.IllegalArgumentException
-   (testgen Integer/MAX_VALUE)))
- (is (thrown? java.lang.IllegalArgumentException (testgen 22/7)))
- (is (thrown? java.lang.IllegalArgumentException (testgen 1.0E-4)))
- (is (thrown? java.lang.IllegalArgumentException (testgen -1.0E-4)))
- (is (= (testgen "test-") nil)))
-
+  (thrown? clojure.lang.ArityException (write-test Integer/MAX_VALUE)))
+ (is (thrown? clojure.lang.ArityException (write-test 22/7)))
+ (is (thrown? clojure.lang.ArityException (write-test 1.0E-4)))
+ (is (thrown? clojure.lang.ArityException (write-test -1.0E-4))))
 (deftest
 test-constant?
 (is (= (constant? nil) 'true))
@ -53,7 +31,46 @@
 (is (= (constant? 22/7) 'true))
 (is (= (constant? 1.0E-4) 'true))
 (is (= (constant? -1.0E-4) 'true)))
-
+(deftest
+ test-generic-args
+ (is (thrown? java.lang.ClassCastException (generic-args nil)))
+ (is (thrown? java.lang.ClassCastException (generic-args ())))
+ (is (thrown? java.lang.ClassCastException (generic-args '(a :b "c"))))
+ (is (thrown? java.lang.ClassCastException (generic-args true)))
+ (is (thrown? java.lang.ClassCastException (generic-args "test")))
+ (is (thrown? java.lang.ClassCastException (generic-args :test)))
+ (is (thrown? java.lang.ClassCastException (generic-args 0)))
+ (is
+  (thrown?
+   java.lang.ClassCastException
+   (generic-args Integer/MAX_VALUE)))
+ (is (thrown? java.lang.ClassCastException (generic-args 22/7)))
+ (is (thrown? java.lang.ClassCastException (generic-args 1.0E-4)))
+ (is (thrown? java.lang.ClassCastException (generic-args -1.0E-4)))
+ (is (thrown? java.lang.ClassCastException (generic-args nil)))
+ (is (thrown? java.lang.ClassCastException (generic-args :b)))
+ (is (thrown? java.lang.ClassCastException (generic-args "c")))
+ (is (thrown? java.lang.ClassCastException (generic-args true)))
+ (is (thrown? java.lang.ClassCastException (generic-args "test")))
+ (is (thrown? java.lang.ClassCastException (generic-args :test)))
+ (is (thrown? java.lang.ClassCastException (generic-args 0)))
+ (is (thrown? java.lang.ClassCastException (generic-args 1)))
+ (is (thrown? java.lang.ClassCastException (generic-args -1)))
+ (is (thrown? java.lang.ClassCastException (generic-args 22/7)))
+ (is
+  (thrown?
+   java.lang.ClassCastException
+   (generic-args 3.142957142857143)))
+ (is
+  (thrown?
+   java.lang.ClassCastException
+   (generic-args 3.1427571428571426)))
+ (is (thrown? java.lang.ClassCastException (generic-args 1.0E-4)))
+ (is (thrown? java.lang.ClassCastException (generic-args 2.0E-4)))
+ (is (thrown? java.lang.ClassCastException (generic-args 0.0)))
+ (is (thrown? java.lang.ClassCastException (generic-args -1.0E-4)))
+ (is (thrown? java.lang.ClassCastException (generic-args 0.0)))
+ (is (thrown? java.lang.ClassCastException (generic-args -2.0E-4))))
 (deftest
 test-constants
 (is (= (constants nil) '()))
@ -72,6 +89,331 @@
   (constants
    "return a list of all elements in this form which are constants")
   '())))
-
-
-
+(deftest
+ test-find-interesting-args
+ (is
+  (=
+   (find-interesting-args nil)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args ())
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args '(a :b "c"))
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4
+     :b
+     "c")))
+ (is
+  (=
+   (find-interesting-args true)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args "test")
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args :test)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 0)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args Integer/MAX_VALUE)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 22/7)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 1.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args -1.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args
+    "Find things in sexpr which would be even more interesting if passed as arguments to it")
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 1.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 2.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 0.0)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 1.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 2.0E-4)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args 0.0)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4)))
+ (is
+  (=
+   (find-interesting-args true)
+   '(nil
+     ()
+     '(a :b "c")
+     true
+     "test"
+     :test
+     0
+     Integer/MAX_VALUE
+     22/7
+     1.0E-4
+     -1.0E-4))))
+(deftest
+ test-testgen
+ (is (= (testgen nil) 'nil))
+ (is (= (testgen ()) 'nil))
+ (is (= (testgen '(a :b "c")) 'nil))
+ (is (thrown? java.lang.IllegalArgumentException (testgen true)))
+ (is (= (testgen "test") 'nil))
+ (is (thrown? java.lang.IllegalArgumentException (testgen :test)))
+ (is (thrown? java.lang.IllegalArgumentException (testgen 0)))
+ (is
+  (thrown?
+   java.lang.IllegalArgumentException
+   (testgen Integer/MAX_VALUE)))
+ (is (thrown? java.lang.IllegalArgumentException (testgen 22/7)))
+ (is (thrown? java.lang.IllegalArgumentException (testgen 1.0E-4)))
+ (is (thrown? java.lang.IllegalArgumentException (testgen -1.0E-4)))
+ (is (= (testgen "test-") 'nil)))
+(deftest
+ test-clean-filename
+ (is (thrown? java.lang.NullPointerException (clean-filename nil)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename ())))
+ (is
+  (thrown?
+   java.lang.IllegalArgumentException
+   (clean-filename '(a :b "c"))))
+ (is
+  (thrown? java.lang.IllegalArgumentException (clean-filename true)))
+ (is (= (clean-filename "test") '"test"))
+ (is
+  (thrown? java.lang.IllegalArgumentException (clean-filename :test)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 0)))
+ (is
+  (thrown?
+   java.lang.IllegalArgumentException
+   (clean-filename Integer/MAX_VALUE)))
+ (is
+  (thrown? java.lang.IllegalArgumentException (clean-filename 22/7)))
+ (is
+  (thrown? java.lang.IllegalArgumentException (clean-filename 1.0E-4)))
+ (is
+  (thrown?
+   java.lang.IllegalArgumentException
+   (clean-filename -1.0E-4)))
+ (is
+  (=
+   (clean-filename
+    "remove the trailing '.clj' from a Clojure file name")
+   '"remove the trailing '.clj' from a Clojure file name"))
+ (is (= (clean-filename ".clj") '""))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 0)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 1)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename -1)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 4)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 5)))
+ (is (thrown? java.lang.IllegalArgumentException (clean-filename 3)))
+ (is
+  (thrown? java.lang.IllegalArgumentException (clean-filename true))))