]> gitweb.factorcode.org Git - factor.git/commitdiff
Add tools.code-coverage vocab to assist in writing unit tests
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 26 Aug 2011 18:37:40 +0000 (13:37 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 26 Aug 2011 18:37:40 +0000 (13:37 -0500)
basis/tools/code-coverage/authors.txt [new file with mode: 0644]
basis/tools/code-coverage/code-coverage.factor [new file with mode: 0644]
basis/tools/code-coverage/summary.txt [new file with mode: 0644]

diff --git a/basis/tools/code-coverage/authors.txt b/basis/tools/code-coverage/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/tools/code-coverage/code-coverage.factor b/basis/tools/code-coverage/code-coverage.factor
new file mode 100644 (file)
index 0000000..5aabb1f
--- /dev/null
@@ -0,0 +1,51 @@
+! Copyright (C) 2011 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs fry kernel quotations sequences strings
+tools.annotations vocabs words prettyprint io ;
+IN: tools.code-coverage
+
+TUPLE: coverage < identity-tuple executed? ;
+
+C: <coverage> coverage
+
+GENERIC: code-coverage-on ( object -- )
+
+GENERIC: code-coverage-off ( object -- )
+
+M: string code-coverage-on
+    words [ code-coverage-on ] each ;
+
+M: string code-coverage-off ( vocabulary -- )
+    words [ code-coverage-off ] each ;
+
+M: word code-coverage-on ( word -- )
+    H{ } clone [ "code-coverage" set-word-prop ] 2keep
+    '[
+        coverage new [ _ set-at ] 2keep
+        '[ _ t >>executed? drop ] [ ] surround
+    ] deep-annotate ;
+
+M: word code-coverage-off ( word -- )
+    [ reset ] [ f "code-coverage" set-word-prop ] bi ;
+
+GENERIC: untested ( object -- seq )
+
+M: string untested
+    words [ dup untested ] { } map>assoc ;
+
+M: word untested ( word -- seq )
+    "code-coverage" word-prop >alist
+    [ drop executed?>> not ] assoc-filter values ;
+
+GENERIC: show-untested ( object -- )
+
+M: string show-untested
+    words [ show-untested ] each ;
+
+M: word show-untested
+    dup untested [
+        drop
+    ] [
+        [ name>> ":" append print ]
+        [ [ bl bl bl bl . ] each ] bi*
+    ] if-empty ;
diff --git a/basis/tools/code-coverage/summary.txt b/basis/tools/code-coverage/summary.txt
new file mode 100644 (file)
index 0000000..02279b3
--- /dev/null
@@ -0,0 +1 @@
+A tool that uses annotations to determine which code paths are taken.