add testcoverage target using hpc

added a test for key read and show

.gitignore

@@ -8,3 +8,5 @@ git-annex.1
 git-annex-shell.1
 doc/.ikiwiki
 html
+*.tix
+.hpc

Makefile

@@ -33,6 +33,13 @@ test:
 	$(GHCMAKE) test
 	./test
 
+testcoverage:
+	rm -f test.tix test
+	ghc -odir build/test -hidir build/test $(GHCFLAGS) --make -fhpc test
+	./test
+	hpc report test --exclude=Main --exclude=QC
+	hpc markup test --exclude=Main --exclude=QC --destdir=.hpc
+
 # If ikiwiki is available, build static html docs suitable for being
 # shipped in the software package.
 ifeq ($(shell which ikiwiki),)
@@ -49,7 +56,7 @@ docs: $(mans)
 		--exclude='news/.*'
 
 clean:
-	rm -rf build $(bins) $(mans) test configure SysConfig.hs
+	rm -rf build $(bins) $(mans) test configure SysConfig.hs *.tix .hpc
 	rm -rf doc/.ikiwiki html
 
 .PHONY: $(bins) test install

TypeInternals.hs

@@ -12,6 +12,7 @@ module TypeInternals where
 import Control.Monad.State (StateT)
 import Data.String.Utils
 import qualified Data.Map as M
+import Test.QuickCheck
 
 import qualified GitRepo as Git
 import qualified GitQueue
@@ -57,6 +58,23 @@ instance Read Key where
 			b = head l
 			k = join ":" $ drop 1 l
 
+-- for quickcheck
+instance Arbitrary Key where
+	arbitrary = do
+		backendname <- arbitrary
+		keyname <- arbitrary
+		return $ Key (backendname, keyname)
+
+prop_idempotent_key_read_show :: Key -> Bool
+prop_idempotent_key_read_show k
+	-- filter out empty key or backend names
+	-- also backend names will not contain colons
+	| null kname || null bname || elem ':' bname = True
+	| otherwise = k == (read $ show k)
+	where
+		bname = backendName k
+		kname = keyName k
+
 backendName :: Key -> BackendName
 backendName (Key (b,_)) = b
 keyName :: Key -> KeyName

test.hs

@@ -4,14 +4,17 @@ import Test.HUnit.Tools
 import GitRepo
 import Locations
 import Utility
+import TypeInternals
 
 alltests :: [Test]
 alltests = [
 	qctest "prop_idempotent_deencode" prop_idempotent_deencode,
 	qctest "prop_idempotent_fileKey" prop_idempotent_fileKey,
+	qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show,
 	qctest "prop_idempotent_shellescape" prop_idempotent_shellescape,
 	qctest "prop_idempotent_shellescape_multiword" prop_idempotent_shellescape_multiword
 	]
 
 main :: IO (Counts, Int)
 main = runVerboseTests (TestList alltests)
+