Code coverage tools allow a programmer to determine what parts of their code have been actually executed, and which parts have never actually been invoked. GHC has an option for generating instrumented code that records code coverage as part of the Haskell Program Coverage (HPC) toolkit, which is included with GHC. HPC tools can be used to render the generated code coverage information into human understandable format.
Correctly instrumented code provides coverage information of two kinds: source coverage and boolean-control coverage. Source coverage is the extent to which every part of the program was used, measured at three different levels: declarations (both top-level and local), alternatives (among several equations or case branches) and expressions (at every level). Boolean coverage is the extent to which each of the values True and False is obtained in every syntactic boolean context (ie. guard, condition, qualifier).
HPC displays both kinds of information in two primary ways:
textual reports with summary statistics (hpc report
) and sources
with color mark-up (hpc markup
). For boolean coverage, there
are four possible outcomes for each guard, condition or
qualifier: both True and False values occur; only True; only
False; never evaluated. In hpc-markup output, highlighting with
a yellow background indicates a part of the program that was
never evaluated; a green background indicates an always-True
expression and a red background indicates an always-False one.
For an example we have a program, called Recip.hs
, which computes exact decimal
representations of reciprocals, with recurring parts indicated in
brackets.
reciprocal :: Int -> (String, Int) reciprocal n | n > 1 = ('0' : '.' : digits, recur) | otherwise = error "attempting to compute reciprocal of number <= 1" where (digits, recur) = divide n 1 [] divide :: Int -> Int -> [Int] -> (String, Int) divide n c cs | c `elem` cs = ([], position c cs) | r == 0 = (show q, 0) | r /= 0 = (show q ++ digits, recur) where (q, r) = (c*10) `quotRem` n (digits, recur) = divide n r (c:cs) position :: Int -> [Int] -> Int position n (x:xs) | n==x = 1 | otherwise = 1 + position n xs showRecip :: Int -> String showRecip n = "1/" ++ show n ++ " = " ++ if r==0 then d else take p d ++ "(" ++ drop p d ++ ")" where p = length d - r (d, r) = reciprocal n main = do number <- readLn putStrLn (showRecip number) main
HPC instrumentation is enabled with the -fhpc flag:
$ ghc -fhpc Recip.hs
GHC creates a subdirectory .hpc
in the
current directory, and puts HPC index (.mix
)
files in there, one for each module compiled. You don't need to
worry about these files: they contain information needed by the
hpc
tool to generate the coverage data for
compiled modules after the program is run.
$ ./Recip 1/3 = 0.(3)
Running the program generates a file with the
.tix
suffix, in this case
Recip.tix
, which contains the coverage data
for this run of the program. The program may be run multiple
times (e.g. with different test data), and the coverage data from
the separate runs is accumulated in the .tix
file. To reset the coverage data and start again, just remove the
.tix
file.
Having run the program, we can generate a textual summary of coverage:
$ hpc report Recip 80% expressions used (81/101) 12% boolean coverage (1/8) 14% guards (1/7), 3 always True, 1 always False, 2 unevaluated 0% 'if' conditions (0/1), 1 always False 100% qualifiers (0/0) 55% alternatives used (5/9) 100% local declarations used (9/9) 100% top-level declarations used (5/5)
We can also generate a marked-up version of the source.
$ hpc markup Recip writing Recip.hs.html
This generates one file per Haskell module, and 4 index files, hpc_index.html, hpc_index_alt.html, hpc_index_exp.html, hpc_index_fun.html.
-fhpc
Enable code coverage for the current module or modules being compiled.
Modules compiled with this option can be freely mixed
with modules compiled without it; indeed, most libraries
will typically be compiled without -fhpc
.
When the program is run, coverage data will only be
generated for those modules that were compiled with
-fhpc
, and the hpc
tool
will only show information about those modules.
The hpc command has several sub-commands:
$ hpc Usage: hpc COMMAND ... Commands: help Display help for hpc or a single command Reporting Coverage: report Output textual report about program coverage markup Markup Haskell source with program coverage Processing Coverage files: sum Sum multiple .tix files in a single .tix file combine Combine two .tix files in a single .tix file map Map a function over a single .tix file Coverage Overlays: overlay Generate a .tix file from an overlay file draft Generate draft overlay that provides 100% coverage Others: show Show .tix file in readable, verbose format version Display version for hpc
In general, these options act on a
.tix
file after an instrumented binary has
generated it.
The hpc tool assumes you are in the top-level directory of
the location where you built your application, and the .tix
file is in the same top-level directory. You can use the
flag --srcdir
to use hpc
for any other directory, and use
--srcdir
multiple times to analyse programs compiled from
difference locations, as is typical for packages.
We now explain in more details the major modes of hpc.
hpc report
gives a textual report of coverage. By default,
all modules and packages are considered in generating report,
unless include or exclude are used. The report is a summary
unless the --per-module
flag is used. The --xml-output
option
allows for tools to use hpc to glean coverage.
$ hpc help report Usage: hpc report [OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]] Options: --per-module show module level detail --decl-list show unused decls --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --srcdir=DIR path to source directory of .hs files multi-use of srcdir possible --hpcdir=DIR append sub-directory that contains .mix files default .hpc [rarely used] --reset-hpcdirs empty the list of hpcdir's [rarely used] --xml-output show output in XML
hpc markup
marks up source files into colored html.
$ hpc help markup Usage: hpc markup [OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]] Options: --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --srcdir=DIR path to source directory of .hs files multi-use of srcdir possible --hpcdir=DIR append sub-directory that contains .mix files default .hpc [rarely used] --reset-hpcdirs empty the list of hpcdir's [rarely used] --fun-entry-count show top-level function entry counts --highlight-covered highlight covered code, rather that code gaps --destdir=DIR path to write output to
hpc sum
adds together any number of .tix
files into a single
.tix
file. hpc sum
does not change the original .tix
file; it generates a new .tix
file.
$ hpc help sum Usage: hpc sum [OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]] Sum multiple .tix files in a single .tix file Options: --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --output=FILE output FILE --union use the union of the module namespace (default is intersection)
hpc combine
is the swiss army knife of hpc
. It can be
used to take the difference between .tix
files, to subtract one
.tix
file from another, or to add two .tix
files. hpc combine does not
change the original .tix
file; it generates a new .tix
file.
$ hpc help combine Usage: hpc combine [OPTION] .. <TIX_FILE> <TIX_FILE> Combine two .tix files in a single .tix file Options: --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --output=FILE output FILE --function=FUNCTION combine .tix files with join function, default = ADD FUNCTION = ADD | DIFF | SUB --union use the union of the module namespace (default is intersection)
hpc map inverts or zeros a .tix
file. hpc map does not
change the original .tix
file; it generates a new .tix
file.
$ hpc help map Usage: hpc map [OPTION] .. <TIX_FILE> Map a function over a single .tix file Options: --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --output=FILE output FILE --function=FUNCTION apply function to .tix files, default = ID FUNCTION = ID | INV | ZERO --union use the union of the module namespace (default is intersection)
Overlays are an experimental feature of HPC, a textual description of coverage. hpc draft is used to generate a draft overlay from a .tix file, and hpc overlay generates a .tix files from an overlay.
% hpc help overlay Usage: hpc overlay [OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]] Options: --srcdir=DIR path to source directory of .hs files multi-use of srcdir possible --hpcdir=DIR append sub-directory that contains .mix files default .hpc [rarely used] --reset-hpcdirs empty the list of hpcdir's [rarely used] --output=FILE output FILE % hpc help draft Usage: hpc draft [OPTION] .. <TIX_FILE> Options: --exclude=[PACKAGE:][MODULE] exclude MODULE and/or PACKAGE --include=[PACKAGE:][MODULE] include MODULE and/or PACKAGE --srcdir=DIR path to source directory of .hs files multi-use of srcdir possible --hpcdir=DIR append sub-directory that contains .mix files default .hpc [rarely used] --reset-hpcdirs empty the list of hpcdir's [rarely used] --output=FILE output FILE
HPC does not attempt to lock the .tix
file, so multiple concurrently running
binaries in the same directory will exhibit a race condition. There is no way
to change the name of the .tix
file generated, apart from renaming the binary.
HPC does not work with GHCi.