diff --git a/hpc-bin.cabal b/hpc-bin.cabal
index 512f5dc0a939d4d748707a5470431189d461cbf0..b8c84a6ac5e9f65a8978aa63e106ba48a6c6dd4f 100644
--- a/hpc-bin.cabal
+++ b/hpc-bin.cabal
@@ -70,6 +70,14 @@ test-suite hpc-test
   main-is: Main.hs
   other-modules:
       Paths_hpc_bin
+      Utils
+      GHC.Tests
+      ShowTix.Tests
+      Report.Tests
+      Version.Tests
+      Map.Tests
+      Sum.Tests
+      Combine.Tests
   autogen-modules:
       Paths_hpc_bin
   hs-source-dirs:
diff --git a/test/Combine/Tests.hs b/test/Combine/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..0360d2e56b2da042f2fb8b2f3f159d742ba2a2c4
--- /dev/null
+++ b/test/Combine/Tests.hs
@@ -0,0 +1,25 @@
+module Combine.Tests (combineTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+inputBaseDir :: FilePath
+inputBaseDir = FP.joinPath ["test", "Combine", "input"]
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "Combine", "gold"]
+
+-- | Tests of the "hpc combine" subcommand
+combineTests :: TestTree
+combineTests = testGroup "combine" [helpTextTest]
+
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help combine"]
diff --git a/test/Combine/gold/Help.stdout b/test/Combine/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..51b43ed489ccf9acf1a77d329e500a6735acd007
--- /dev/null
+++ b/test/Combine/gold/Help.stdout
@@ -0,0 +1,15 @@
+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)
+    --verbosity=[0-2]             verbosity level, 0-2
+                                  default 1
+
diff --git a/test/GHC/Tests.hs b/test/GHC/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..494d492c9b646dd04c41f75e4bc13a5c7ab44ffa
--- /dev/null
+++ b/test/GHC/Tests.hs
@@ -0,0 +1,101 @@
+module GHC.Tests (ghcTests) where
+import System.Process
+import System.Environment (getEnv)
+import System.Directory (doesFileExist)
+import Data.List
+import Control.Monad (void)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import qualified System.FilePath as FP
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.Golden as G
+
+-- | Tests coming from the GHC testsuite
+ghcTests :: TestTree
+ghcTests = testGroup "ghc-suite" $
+    [ t10138
+    , t2991
+    , t17073
+    , t20568
+    , t11798
+    ]
+
+inputDir :: FilePath
+inputDir = "test" FP.</> "GHC" FP.</> "inputs"
+
+goldDir :: FilePath
+goldDir = FP.joinPath ["test", "GHC", "gold"]
+
+goldFile :: FilePath -> FilePath
+goldFile file = goldDir FP.</> file
+
+rm :: [FilePath] -> IO ()
+rm files = void $ readCreateProcess ((shell (intercalate " && " . map ("rm -r " <>) $ files)) { cwd = Just inputDir }) ""
+
+runCommands :: [IO String] -> IO String
+runCommands commands = do
+    cmds <- traverse id commands
+    readCreateProcess ((shell $ intercalate " && " cmds) { cwd = Just inputDir }) "" 
+
+hpc :: String -> IO String
+hpc args = (<> args) . (<> " ") <$> getEnv "HPC"
+
+ghc :: String -> IO String
+ghc args = (<> args) . (<> " ") <$> getEnv "GHC"
+
+exec :: String -> String
+exec = ("./" <>)
+
+{- Tests -}
+
+t10138 :: TestTree
+t10138 = testCaseInfo "T10138" $ runCommands . pure $ hpc . intercalate " " $ 
+    ["report", "T10138.keepme.tix", "--hpcdir=.keepme.hpc.T10138"]
+
+t2991 :: TestTree
+t2991 = testCaseInfo "T2991" $ do
+    runCommands commands
+    clean
+    pure ""
+  where
+    -- The .mix file for the literate module should have non-zero entries
+    -- The 'grep' should exit with exit code 0
+    commands = [ghc "-fhpc T2991.hs", pure $ exec "T2991", pure "grep -q cover_me .hpc/T2991LiterateModule.mix"]
+    clean = rm ["*.hi", "*.o", "T2991", "T2991.tix", ".hpc"]  
+
+t17073 :: TestTree
+t17073 = goldenVsString "T17073" (goldFile "T17073.stdout") $ do 
+        out1 <- runCommands commands
+        clean
+        pure $ BS.fromString out1
+  where
+    commands = [ ("LANG=ASCII " <>) <$> ghc "-fhpc -v0 T17073.hs"
+                , pure $ exec "T17073"
+                , hpc "report T17073"
+                , hpc "version"
+                , ("LANG=ASCII " <>) <$> hpc "markup T17073"
+                ]
+    clean = rm ["T17073.hi", "T17073.o", "T17073", "*.html", "T17073.tix", ".hpc"]
+
+t20568 :: TestTree
+t20568 = goldenVsString "T20568" (goldFile "T20568.stdout") $ do
+        out <- runCommands commands
+        clean
+        pure $ BS.fromString $ last . lines $ out
+  where
+    commands = [ghc "T20568", pure $ exec "T20568"]
+    clean = rm ["T20568.hi", "T20568.o", "T20568"]    
+
+-- test that adding -fhpc triggers recompilation
+t11798 :: TestTree
+t11798 = goldenVsString "T11798" (goldFile "T11798.stdout") $ do
+        c1 <- ghc "T11798.hs"
+        out1 <- readCreateProcess ((shell c1) { cwd = Just inputDir }) ""
+        c2 <- ghc "-fhpc T11798.hs"
+        out2 <- readCreateProcess ((shell c2) { cwd = Just inputDir }) ""
+        fmap (assertBool ".hpc/T11798.mix does not exist") $ doesFileExist $ 
+            ".hpc" FP.</> "T11798.mix"
+        clean
+        pure $ BS.fromString $ unlines [last . lines $ out1,  last . lines $ out2]
+  where
+    clean = rm ["T11798.hi", "T11798.o", ".hpc"]
diff --git a/test/gold/T11798.stdout b/test/GHC/gold/T11798.stdout
similarity index 100%
rename from test/gold/T11798.stdout
rename to test/GHC/gold/T11798.stdout
diff --git a/test/gold/T17073.stdout b/test/GHC/gold/T17073.stdout
similarity index 100%
rename from test/gold/T17073.stdout
rename to test/GHC/gold/T17073.stdout
diff --git a/test/gold/T20568.stdout b/test/GHC/gold/T20568.stdout
similarity index 100%
rename from test/gold/T20568.stdout
rename to test/GHC/gold/T20568.stdout
diff --git a/test/inputs/.keepme.hpc.T10138/Main.mix b/test/GHC/inputs/.keepme.hpc.T10138/Main.mix
similarity index 100%
rename from test/inputs/.keepme.hpc.T10138/Main.mix
rename to test/GHC/inputs/.keepme.hpc.T10138/Main.mix
diff --git a/test/inputs/T10138.keepme.tix b/test/GHC/inputs/T10138.keepme.tix
similarity index 100%
rename from test/inputs/T10138.keepme.tix
rename to test/GHC/inputs/T10138.keepme.tix
diff --git a/test/inputs/T11798.hs b/test/GHC/inputs/T11798.hs
similarity index 100%
rename from test/inputs/T11798.hs
rename to test/GHC/inputs/T11798.hs
diff --git a/test/inputs/T17073.hs b/test/GHC/inputs/T17073.hs
similarity index 100%
rename from test/inputs/T17073.hs
rename to test/GHC/inputs/T17073.hs
diff --git a/test/inputs/T20568.hs b/test/GHC/inputs/T20568.hs
similarity index 100%
rename from test/inputs/T20568.hs
rename to test/GHC/inputs/T20568.hs
diff --git a/test/inputs/T2991.hs b/test/GHC/inputs/T2991.hs
similarity index 100%
rename from test/inputs/T2991.hs
rename to test/GHC/inputs/T2991.hs
diff --git a/test/inputs/T2991LiterateModule.lhs b/test/GHC/inputs/T2991LiterateModule.lhs
similarity index 100%
rename from test/inputs/T2991LiterateModule.lhs
rename to test/GHC/inputs/T2991LiterateModule.lhs
diff --git a/test/Main.hs b/test/Main.hs
index 4b383725db350b8d97a7fdc8b74c13fe60a0333e..ef4b5099bf005dde7392745cf44c6528216b52b1 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,99 +1,16 @@
-import System.Process
-import System.Environment (getEnv)
-import System.Directory (doesFileExist)
-import Data.List
-import Control.Monad (void)
-import qualified Data.ByteString.Lazy.UTF8 as BS
-import qualified System.FilePath as FP
-import Test.Tasty
-import Test.Tasty.HUnit
-import Test.Tasty.Golden as G
+module Main where
 
-main :: IO ()
-main = defaultMain . testGroup "hpc tests" $
-    [ t10138
-    , t2991
-    , t17073
-    , t20568
-    , t11798
-    ]
-
-inputDir :: FilePath
-inputDir = "test" FP.</> "inputs"
-
-goldDir :: FilePath
-goldDir = FP.joinPath ["test", "gold"]
-
-goldFile :: FilePath -> FilePath
-goldFile file = goldDir FP.</> file
-
-rm :: [FilePath] -> IO ()
-rm files = void $ readCreateProcess ((shell (intercalate " && " . map ("rm -r " <>) $ files)) { cwd = Just inputDir }) ""
-
-runCommands :: [IO String] -> IO String
-runCommands commands = do
-    cmds <- traverse id commands
-    readCreateProcess ((shell $ intercalate " && " cmds) { cwd = Just inputDir }) "" 
-
-hpc :: String -> IO String
-hpc args = (<> args) . (<> " ") <$> getEnv "HPC"
+import Test.Tasty ( defaultMain, testGroup, TestTree )
+import GHC.Tests (ghcTests)
+import ShowTix.Tests (showTixTests)
+import Report.Tests (reportTests)
+import Version.Tests (versionTests)
+import Map.Tests (mapTests)
+import Sum.Tests (sumTests)
+import Combine.Tests (combineTests)
 
-ghc :: String -> IO String
-ghc args = (<> args) . (<> " ") <$> getEnv "GHC"
-
-exec :: String -> String
-exec = ("./" <>)
-
-{- Tests -}
-
-t10138 :: TestTree
-t10138 = testCaseInfo "T10138" $ runCommands . pure $ hpc . intercalate " " $ 
-    ["report", "T10138.keepme.tix", "--hpcdir=.keepme.hpc.T10138"]
-
-t2991 :: TestTree
-t2991 = testCaseInfo "T2991" $ do
-    runCommands commands
-    clean
-    pure ""
-  where
-    -- The .mix file for the literate module should have non-zero entries
-    -- The 'grep' should exit with exit code 0
-    commands = [ghc "-fhpc T2991.hs", pure $ exec "T2991", pure "grep -q cover_me .hpc/T2991LiterateModule.mix"]
-    clean = rm ["*.hi", "*.o", "T2991", "T2991.tix", ".hpc"]  
-
-t17073 :: TestTree
-t17073 = goldenVsString "T17073" (goldFile "T17073.stdout") $ do 
-        out1 <- runCommands commands
-        clean
-        pure $ BS.fromString out1
-  where
-    commands = [ ("LANG=ASCII " <>) <$> ghc "-fhpc -v0 T17073.hs"
-                , pure $ exec "T17073"
-                , hpc "report T17073"
-                , hpc "version"
-                , ("LANG=ASCII " <>) <$> hpc "markup T17073"
-                ]
-    clean = rm ["T17073.hi", "T17073.o", "T17073", "*.html", "T17073.tix", ".hpc"]
-
-t20568 :: TestTree
-t20568 = goldenVsString "T20568" (goldFile "T20568.stdout") $ do
-        out <- runCommands commands
-        clean
-        pure $ BS.fromString $ last . lines $ out
-  where
-    commands = [ghc "T20568", pure $ exec "T20568"]
-    clean = rm ["T20568.hi", "T20568.o", "T20568"]    
+main :: IO ()
+main = defaultMain tests
 
--- test that adding -fhpc triggers recompilation
-t11798 :: TestTree
-t11798 = goldenVsString "T11798" (goldFile "T11798.stdout") $ do
-        c1 <- ghc "T11798.hs"
-        out1 <- readCreateProcess ((shell c1) { cwd = Just inputDir }) ""
-        c2 <- ghc "-fhpc T11798.hs"
-        out2 <- readCreateProcess ((shell c2) { cwd = Just inputDir }) ""
-        fmap (assertBool ".hpc/T11798.mix does not exist") $ doesFileExist $ 
-            ".hpc" FP.</> "T11798.mix"
-        clean
-        pure $ BS.fromString $ unlines [last . lines $ out1,  last . lines $ out2]
-  where
-    clean = rm ["T11798.hi", "T11798.o", ".hpc"]
+tests :: TestTree
+tests = testGroup "hpc" [ ghcTests, showTixTests, reportTests, versionTests, mapTests, sumTests, combineTests]
diff --git a/test/Map/Tests.hs b/test/Map/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..79369c43de4b1c88a92d682e52a915951f771355
--- /dev/null
+++ b/test/Map/Tests.hs
@@ -0,0 +1,25 @@
+module Map.Tests (mapTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+inputBaseDir :: FilePath
+inputBaseDir = FP.joinPath ["test", "Map", "input"]
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "Map", "gold"]
+
+-- | Tests of the "hpc map" subcommand
+mapTests :: TestTree
+mapTests = testGroup "map" [helpTextTest]
+
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help map"]
diff --git a/test/Map/gold/Help.stdout b/test/Map/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..a564e03155055f788eb3c3b6e1c1b231ca597a07
--- /dev/null
+++ b/test/Map/gold/Help.stdout
@@ -0,0 +1,15 @@
+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)
+    --verbosity=[0-2]             verbosity level, 0-2
+                                  default 1
+
diff --git a/test/README.md b/test/README.md
new file mode 100644
index 0000000000000000000000000000000000000000..42d900e0f3f6708f7febd543f7a9a3965038ddf1
--- /dev/null
+++ b/test/README.md
@@ -0,0 +1,15 @@
+# Testsuite
+
+## Directory structure
+
+The subdirectory `test/GHC/` contains the tests which also exist in that form in the
+GHC testsuite. The other directories correspond to the various subcommands that `hpc-bin` provides.
+
+## Running the tests
+
+The testsuite expects the two environment variables `HPC` and `GHC` to be set.
+For example, the testsuite can be invoked with:
+
+```console
+HPC=hpc GHC=ghc cabal test
+```
diff --git a/test/Report/Tests.hs b/test/Report/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..6d33703549fbc87aa9d6436a65c1992e2327726f
--- /dev/null
+++ b/test/Report/Tests.hs
@@ -0,0 +1,37 @@
+module Report.Tests (reportTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+
+inputBaseDir :: FilePath
+inputBaseDir = FP.joinPath ["test", "Report", "input"]
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "Report", "gold"]
+
+-- | Tests for the `hpc report` subcommand
+reportTests :: TestTree
+reportTests = testGroup "report" [recipTestNormal, recipTestXML, helpTextTest]
+
+recipTestNormal :: TestTree
+recipTestNormal = goldenVsString "RecipNormal" (goldBaseDir FP.</> "RecipNormal.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands (inputBaseDir FP.</> "Recip") ["hpc report Recip.tix"]
+
+recipTestXML :: TestTree
+recipTestXML = goldenVsString "RecipXML" (goldBaseDir FP.</> "RecipXML.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands (inputBaseDir FP.</> "Recip") ["hpc report --xml-output Recip.tix"]
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help report"]
diff --git a/test/Report/gold/Help.stdout b/test/Report/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..5d73a49ad421477ff9ba2ac9f337ef959fc22d0c
--- /dev/null
+++ b/test/Report/gold/Help.stdout
@@ -0,0 +1,20 @@
+Usage: hpc report [OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]
+Output textual report about program coverage
+
+
+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
+    --verbosity=[0-2]             verbosity level, 0-2
+                                  default 1
+
diff --git a/test/Report/gold/RecipNormal.stdout b/test/Report/gold/RecipNormal.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..18ea8c512203d85a6bab13408684a68acd0c941f
--- /dev/null
+++ b/test/Report/gold/RecipNormal.stdout
@@ -0,0 +1,8 @@
+ 96% expressions used (94/97)
+ 50% boolean coverage (4/8)
+      42% guards (3/7), 3 always True, 1 unevaluated
+     100% 'if' conditions (1/1)
+     100% qualifiers (0/0)
+ 88% alternatives used (8/9)
+100% local declarations used (1/1)
+100% top-level declarations used (5/5)
diff --git a/test/Report/gold/RecipXML.stdout b/test/Report/gold/RecipXML.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..eeb0c898c60cfd7b839094e8640b197dd02cdb80
--- /dev/null
+++ b/test/Report/gold/RecipXML.stdout
@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<coverage name="Recip.tix">
+  <summary>
+    <exprs boxes="97" count="94"/>
+    <booleans boxes="8" true="3" false="0" count="7"/>
+    <guards boxes="7" true="3" false="0" count="6"/>
+    <conditionals boxes="1" true="0" false="0" count="1"/>
+    <qualifiers boxes="0" true="0" false="0" count="0"/>
+    <alts boxes="9" count="8"/>
+    <local boxes="1" count="1"/>
+    <toplevel boxes="5" count="5"/>
+  </summary>
+</coverage>
diff --git a/test/Report/input/Recip/.hpc/Main.mix b/test/Report/input/Recip/.hpc/Main.mix
new file mode 100644
index 0000000000000000000000000000000000000000..7fa25bc99ceddd63ed91b07b4f7630bc9c444a3a
--- /dev/null
+++ b/test/Report/input/Recip/.hpc/Main.mix
@@ -0,0 +1 @@
+Mix "Recip.hs" 2023-10-06 14:57:37.985747475 UTC 1606722211 8 [(18:21-18:21,ExpBox False),(18:24-18:24,ExpBox False),(18:21-18:24,BinBox GuardBinBox True),(18:21-18:24,BinBox GuardBinBox False),(18:21-18:24,ExpBox False),(18:33-18:33,ExpBox True),(19:21-19:29,BinBox GuardBinBox True),(19:21-19:29,BinBox GuardBinBox False),(19:21-19:29,ExpBox False),(19:33-19:33,ExpBox False),(19:46-19:46,ExpBox False),(19:48-19:49,ExpBox False),(19:37-19:49,ExpBox False),(19:33-19:49,ExpBox True),(18:1-19:49,TopLevelBox ["position"]),(14:13-14:13,ExpBox False),(14:15-14:16,ExpBox False),(14:12-14:17,ExpBox False),(14:29-14:29,ExpBox False),(14:12-14:29,ExpBox False),(15:28-15:28,ExpBox False),(15:30-15:30,ExpBox False),(15:33-15:33,ExpBox False),(15:35-15:36,ExpBox False),(15:32-15:37,ExpBox False),(15:21-15:37,ExpBox False),(10:17-10:17,ExpBox False),(10:26-10:27,ExpBox False),(10:17-10:27,BinBox GuardBinBox True),(10:17-10:27,BinBox GuardBinBox False),(10:17-10:27,ExpBox False),(10:32-10:33,ExpBox False),(10:45-10:45,ExpBox False),(10:47-10:48,ExpBox False),(10:36-10:48,ExpBox False),(10:31-10:49,ExpBox True),(11:17-11:17,ExpBox False),(11:22-11:22,ExpBox False),(11:17-11:22,BinBox GuardBinBox True),(11:17-11:22,BinBox GuardBinBox False),(11:17-11:22,ExpBox False),(11:37-11:37,ExpBox False),(11:32-11:37,ExpBox False),(11:40-11:40,ExpBox False),(11:31-11:41,ExpBox True),(12:17-12:17,ExpBox False),(12:22-12:22,ExpBox False),(12:17-12:22,BinBox GuardBinBox True),(12:17-12:22,BinBox GuardBinBox False),(12:17-12:22,ExpBox False),(12:37-12:37,ExpBox False),(12:32-12:37,ExpBox False),(12:42-12:47,ExpBox False),(12:32-12:47,ExpBox False),(12:50-12:54,ExpBox False),(12:31-12:55,ExpBox True),(10:1-15:37,TopLevelBox ["divide"]),(8:28-8:28,ExpBox False),(8:30-8:30,ExpBox False),(8:32-8:33,ExpBox False),(8:21-8:33,ExpBox False),(4:16-4:16,ExpBox False),(4:20-4:20,ExpBox False),(4:16-4:20,BinBox GuardBinBox True),(4:16-4:20,BinBox GuardBinBox False),(4:16-4:20,ExpBox False),(4:25-4:27,ExpBox False),(4:31-4:33,ExpBox False),(4:37-4:42,ExpBox False),(4:31-4:42,ExpBox False),(4:25-4:42,ExpBox False),(4:45-4:49,ExpBox False),(4:24-4:50,ExpBox True),(5:16-5:24,BinBox GuardBinBox True),(5:16-5:24,BinBox GuardBinBox False),(5:16-5:24,ExpBox False),(6:15-6:63,ExpBox False),(5:28-6:63,ExpBox True),(4:1-8:33,TopLevelBox ["reciprocal"]),(27:23-27:23,ExpBox False),(27:12-27:23,ExpBox False),(26:14-26:14,ExpBox False),(26:7-26:14,ExpBox False),(26:18-26:18,ExpBox False),(26:7-26:18,ExpBox False),(26:3-26:18,LocalBox ["showRecip","p"]),(23:3-23:6,ExpBox False),(23:16-23:16,ExpBox False),(23:11-23:16,ExpBox False),(23:21-23:25,ExpBox False),(24:6-24:6,ExpBox False),(24:9-24:9,ExpBox False),(24:6-24:9,BinBox CondBinBox True),(24:6-24:9,BinBox CondBinBox False),(24:6-24:9,ExpBox False),(24:16-24:16,ExpBox True),(24:28-24:28,ExpBox False),(24:30-24:30,ExpBox False),(24:23-24:30,ExpBox False),(24:35-24:37,ExpBox False),(24:47-24:47,ExpBox False),(24:49-24:49,ExpBox False),(24:42-24:49,ExpBox False),(24:54-24:56,ExpBox False),(24:42-24:56,ExpBox False),(24:35-24:56,ExpBox False),(24:23-24:56,ExpBox True),(24:3-24:56,ExpBox False),(23:21-24:56,ExpBox False),(23:11-24:56,ExpBox False),(23:3-24:56,ExpBox False),(22:1-27:23,TopLevelBox ["showRecip"]),(30:13-30:18,ExpBox False),(31:23-31:28,ExpBox False),(31:12-31:29,ExpBox False),(31:3-31:29,ExpBox False),(32:3-32:6,ExpBox False),(29:8-32:6,ExpBox False),(29:1-32:6,TopLevelBox ["main"])]
\ No newline at end of file
diff --git a/test/Report/input/Recip/Recip.hs b/test/Report/input/Recip/Recip.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7571580073dcbe8fdec899e516b0db1556c25c74
--- /dev/null
+++ b/test/Report/input/Recip/Recip.hs
@@ -0,0 +1,33 @@
+module Main where
+
+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
+
diff --git a/test/Report/input/Recip/Recip.tix b/test/Report/input/Recip/Recip.tix
new file mode 100644
index 0000000000000000000000000000000000000000..e71cea5cd60fb58d936ef83f3178bd5464795740
--- /dev/null
+++ b/test/Report/input/Recip/Recip.tix
@@ -0,0 +1 @@
+Tix [ TixModule "Main" 1606722211 119 [7,7,2,5,7,2,5,0,5,5,5,5,5,5,7,12,12,12,12,12,9,11,11,10,11,11,11,14,2,12,14,2,2,2,2,2,12,12,1,11,12,1,1,1,1,11,11,11,0,11,11,11,11,11,11,11,14,3,3,3,3,3,3,3,0,3,3,3,3,3,3,3,3,0,0,0,0,0,3,3,3,2,2,2,2,2,3,3,3,3,3,3,1,2,3,1,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,1,3,3,3,3,1,1]]
diff --git a/test/ShowTix/Tests.hs b/test/ShowTix/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..cf377263c037c6781bf292d239ba9f63925f3411
--- /dev/null
+++ b/test/ShowTix/Tests.hs
@@ -0,0 +1,30 @@
+module ShowTix.Tests (showTixTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+inputBaseDir :: FilePath
+inputBaseDir = FP.joinPath ["test", "ShowTix", "input"]
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "ShowTix", "gold"]
+
+-- | Tests of the "hpc show" subcommand
+showTixTests :: TestTree
+showTixTests = testGroup "show" [recipTest, helpTextTest]
+
+recipTest :: TestTree 
+recipTest = goldenVsString "Recip" (goldBaseDir FP.</> "Recip.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands (inputBaseDir FP.</> "Recip") ["hpc show Recip.tix"]
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help show"]
diff --git a/test/ShowTix/gold/Help.stdout b/test/ShowTix/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..1302178b03b8493e849067158054adbe7ce329e0
--- /dev/null
+++ b/test/ShowTix/gold/Help.stdout
@@ -0,0 +1,18 @@
+Usage: hpc show [OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]
+Show .tix file in readable, verbose format
+
+
+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
+    --verbosity=[0-2]             verbosity level, 0-2
+                                  default 1
+
diff --git a/test/ShowTix/gold/Recip.stdout b/test/ShowTix/gold/Recip.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..9d3d8ce272db3f0f0f77d20cf989869523d15364
--- /dev/null
+++ b/test/ShowTix/gold/Recip.stdout
@@ -0,0 +1,119 @@
+    0          7 Main                          18:21-18:21 ExpBox False
+    1          7 Main                          18:24-18:24 ExpBox False
+    2          2 Main                          18:21-18:24 BinBox GuardBinBox True
+    3          5 Main                          18:21-18:24 BinBox GuardBinBox False
+    4          7 Main                          18:21-18:24 ExpBox False
+    5          2 Main                          18:33-18:33 ExpBox True
+    6          5 Main                          19:21-19:29 BinBox GuardBinBox True
+    7          0 Main                          19:21-19:29 BinBox GuardBinBox False
+    8          5 Main                          19:21-19:29 ExpBox False
+    9          5 Main                          19:33-19:33 ExpBox False
+   10          5 Main                          19:46-19:46 ExpBox False
+   11          5 Main                          19:48-19:49 ExpBox False
+   12          5 Main                          19:37-19:49 ExpBox False
+   13          5 Main                          19:33-19:49 ExpBox True
+   14          7 Main                           18:1-19:49 TopLevelBox ["position"]
+   15         12 Main                          14:13-14:13 ExpBox False
+   16         12 Main                          14:15-14:16 ExpBox False
+   17         12 Main                          14:12-14:17 ExpBox False
+   18         12 Main                          14:29-14:29 ExpBox False
+   19         12 Main                          14:12-14:29 ExpBox False
+   20          9 Main                          15:28-15:28 ExpBox False
+   21         11 Main                          15:30-15:30 ExpBox False
+   22         11 Main                          15:33-15:33 ExpBox False
+   23         10 Main                          15:35-15:36 ExpBox False
+   24         11 Main                          15:32-15:37 ExpBox False
+   25         11 Main                          15:21-15:37 ExpBox False
+   26         11 Main                          10:17-10:17 ExpBox False
+   27         14 Main                          10:26-10:27 ExpBox False
+   28          2 Main                          10:17-10:27 BinBox GuardBinBox True
+   29         12 Main                          10:17-10:27 BinBox GuardBinBox False
+   30         14 Main                          10:17-10:27 ExpBox False
+   31          2 Main                          10:32-10:33 ExpBox False
+   32          2 Main                          10:45-10:45 ExpBox False
+   33          2 Main                          10:47-10:48 ExpBox False
+   34          2 Main                          10:36-10:48 ExpBox False
+   35          2 Main                          10:31-10:49 ExpBox True
+   36         12 Main                          11:17-11:17 ExpBox False
+   37         12 Main                          11:22-11:22 ExpBox False
+   38          1 Main                          11:17-11:22 BinBox GuardBinBox True
+   39         11 Main                          11:17-11:22 BinBox GuardBinBox False
+   40         12 Main                          11:17-11:22 ExpBox False
+   41          1 Main                          11:37-11:37 ExpBox False
+   42          1 Main                          11:32-11:37 ExpBox False
+   43          1 Main                          11:40-11:40 ExpBox False
+   44          1 Main                          11:31-11:41 ExpBox True
+   45         11 Main                          12:17-12:17 ExpBox False
+   46         11 Main                          12:22-12:22 ExpBox False
+   47         11 Main                          12:17-12:22 BinBox GuardBinBox True
+   48          0 Main                          12:17-12:22 BinBox GuardBinBox False
+   49         11 Main                          12:17-12:22 ExpBox False
+   50         11 Main                          12:37-12:37 ExpBox False
+   51         11 Main                          12:32-12:37 ExpBox False
+   52         11 Main                          12:42-12:47 ExpBox False
+   53         11 Main                          12:32-12:47 ExpBox False
+   54         11 Main                          12:50-12:54 ExpBox False
+   55         11 Main                          12:31-12:55 ExpBox True
+   56         14 Main                           10:1-15:37 TopLevelBox ["divide"]
+   57          3 Main                            8:28-8:28 ExpBox False
+   58          3 Main                            8:30-8:30 ExpBox False
+   59          3 Main                            8:32-8:33 ExpBox False
+   60          3 Main                            8:21-8:33 ExpBox False
+   61          3 Main                            4:16-4:16 ExpBox False
+   62          3 Main                            4:20-4:20 ExpBox False
+   63          3 Main                            4:16-4:20 BinBox GuardBinBox True
+   64          0 Main                            4:16-4:20 BinBox GuardBinBox False
+   65          3 Main                            4:16-4:20 ExpBox False
+   66          3 Main                            4:25-4:27 ExpBox False
+   67          3 Main                            4:31-4:33 ExpBox False
+   68          3 Main                            4:37-4:42 ExpBox False
+   69          3 Main                            4:31-4:42 ExpBox False
+   70          3 Main                            4:25-4:42 ExpBox False
+   71          3 Main                            4:45-4:49 ExpBox False
+   72          3 Main                            4:24-4:50 ExpBox True
+   73          0 Main                            5:16-5:24 BinBox GuardBinBox True
+   74          0 Main                            5:16-5:24 BinBox GuardBinBox False
+   75          0 Main                            5:16-5:24 ExpBox False
+   76          0 Main                            6:15-6:63 ExpBox False
+   77          0 Main                            5:28-6:63 ExpBox True
+   78          3 Main                             4:1-8:33 TopLevelBox ["reciprocal"]
+   79          3 Main                          27:23-27:23 ExpBox False
+   80          3 Main                          27:12-27:23 ExpBox False
+   81          2 Main                          26:14-26:14 ExpBox False
+   82          2 Main                           26:7-26:14 ExpBox False
+   83          2 Main                          26:18-26:18 ExpBox False
+   84          2 Main                           26:7-26:18 ExpBox False
+   85          2 Main                           26:3-26:18 LocalBox ["showRecip","p"]
+   86          3 Main                            23:3-23:6 ExpBox False
+   87          3 Main                          23:16-23:16 ExpBox False
+   88          3 Main                          23:11-23:16 ExpBox False
+   89          3 Main                          23:21-23:25 ExpBox False
+   90          3 Main                            24:6-24:6 ExpBox False
+   91          3 Main                            24:9-24:9 ExpBox False
+   92          1 Main                            24:6-24:9 BinBox CondBinBox True
+   93          2 Main                            24:6-24:9 BinBox CondBinBox False
+   94          3 Main                            24:6-24:9 ExpBox False
+   95          1 Main                          24:16-24:16 ExpBox True
+   96          2 Main                          24:28-24:28 ExpBox False
+   97          2 Main                          24:30-24:30 ExpBox False
+   98          2 Main                          24:23-24:30 ExpBox False
+   99          2 Main                          24:35-24:37 ExpBox False
+  100          2 Main                          24:47-24:47 ExpBox False
+  101          2 Main                          24:49-24:49 ExpBox False
+  102          2 Main                          24:42-24:49 ExpBox False
+  103          2 Main                          24:54-24:56 ExpBox False
+  104          2 Main                          24:42-24:56 ExpBox False
+  105          2 Main                          24:35-24:56 ExpBox False
+  106          2 Main                          24:23-24:56 ExpBox True
+  107          3 Main                           24:3-24:56 ExpBox False
+  108          3 Main                          23:21-24:56 ExpBox False
+  109          3 Main                          23:11-24:56 ExpBox False
+  110          3 Main                           23:3-24:56 ExpBox False
+  111          3 Main                           22:1-27:23 TopLevelBox ["showRecip"]
+  112          1 Main                          30:13-30:18 ExpBox False
+  113          3 Main                          31:23-31:28 ExpBox False
+  114          3 Main                          31:12-31:29 ExpBox False
+  115          3 Main                           31:3-31:29 ExpBox False
+  116          3 Main                            32:3-32:6 ExpBox False
+  117          1 Main                            29:8-32:6 ExpBox False
+  118          1 Main                            29:1-32:6 TopLevelBox ["main"]
diff --git a/test/ShowTix/input/Recip/.hpc/Main.mix b/test/ShowTix/input/Recip/.hpc/Main.mix
new file mode 100644
index 0000000000000000000000000000000000000000..7fa25bc99ceddd63ed91b07b4f7630bc9c444a3a
--- /dev/null
+++ b/test/ShowTix/input/Recip/.hpc/Main.mix
@@ -0,0 +1 @@
+Mix "Recip.hs" 2023-10-06 14:57:37.985747475 UTC 1606722211 8 [(18:21-18:21,ExpBox False),(18:24-18:24,ExpBox False),(18:21-18:24,BinBox GuardBinBox True),(18:21-18:24,BinBox GuardBinBox False),(18:21-18:24,ExpBox False),(18:33-18:33,ExpBox True),(19:21-19:29,BinBox GuardBinBox True),(19:21-19:29,BinBox GuardBinBox False),(19:21-19:29,ExpBox False),(19:33-19:33,ExpBox False),(19:46-19:46,ExpBox False),(19:48-19:49,ExpBox False),(19:37-19:49,ExpBox False),(19:33-19:49,ExpBox True),(18:1-19:49,TopLevelBox ["position"]),(14:13-14:13,ExpBox False),(14:15-14:16,ExpBox False),(14:12-14:17,ExpBox False),(14:29-14:29,ExpBox False),(14:12-14:29,ExpBox False),(15:28-15:28,ExpBox False),(15:30-15:30,ExpBox False),(15:33-15:33,ExpBox False),(15:35-15:36,ExpBox False),(15:32-15:37,ExpBox False),(15:21-15:37,ExpBox False),(10:17-10:17,ExpBox False),(10:26-10:27,ExpBox False),(10:17-10:27,BinBox GuardBinBox True),(10:17-10:27,BinBox GuardBinBox False),(10:17-10:27,ExpBox False),(10:32-10:33,ExpBox False),(10:45-10:45,ExpBox False),(10:47-10:48,ExpBox False),(10:36-10:48,ExpBox False),(10:31-10:49,ExpBox True),(11:17-11:17,ExpBox False),(11:22-11:22,ExpBox False),(11:17-11:22,BinBox GuardBinBox True),(11:17-11:22,BinBox GuardBinBox False),(11:17-11:22,ExpBox False),(11:37-11:37,ExpBox False),(11:32-11:37,ExpBox False),(11:40-11:40,ExpBox False),(11:31-11:41,ExpBox True),(12:17-12:17,ExpBox False),(12:22-12:22,ExpBox False),(12:17-12:22,BinBox GuardBinBox True),(12:17-12:22,BinBox GuardBinBox False),(12:17-12:22,ExpBox False),(12:37-12:37,ExpBox False),(12:32-12:37,ExpBox False),(12:42-12:47,ExpBox False),(12:32-12:47,ExpBox False),(12:50-12:54,ExpBox False),(12:31-12:55,ExpBox True),(10:1-15:37,TopLevelBox ["divide"]),(8:28-8:28,ExpBox False),(8:30-8:30,ExpBox False),(8:32-8:33,ExpBox False),(8:21-8:33,ExpBox False),(4:16-4:16,ExpBox False),(4:20-4:20,ExpBox False),(4:16-4:20,BinBox GuardBinBox True),(4:16-4:20,BinBox GuardBinBox False),(4:16-4:20,ExpBox False),(4:25-4:27,ExpBox False),(4:31-4:33,ExpBox False),(4:37-4:42,ExpBox False),(4:31-4:42,ExpBox False),(4:25-4:42,ExpBox False),(4:45-4:49,ExpBox False),(4:24-4:50,ExpBox True),(5:16-5:24,BinBox GuardBinBox True),(5:16-5:24,BinBox GuardBinBox False),(5:16-5:24,ExpBox False),(6:15-6:63,ExpBox False),(5:28-6:63,ExpBox True),(4:1-8:33,TopLevelBox ["reciprocal"]),(27:23-27:23,ExpBox False),(27:12-27:23,ExpBox False),(26:14-26:14,ExpBox False),(26:7-26:14,ExpBox False),(26:18-26:18,ExpBox False),(26:7-26:18,ExpBox False),(26:3-26:18,LocalBox ["showRecip","p"]),(23:3-23:6,ExpBox False),(23:16-23:16,ExpBox False),(23:11-23:16,ExpBox False),(23:21-23:25,ExpBox False),(24:6-24:6,ExpBox False),(24:9-24:9,ExpBox False),(24:6-24:9,BinBox CondBinBox True),(24:6-24:9,BinBox CondBinBox False),(24:6-24:9,ExpBox False),(24:16-24:16,ExpBox True),(24:28-24:28,ExpBox False),(24:30-24:30,ExpBox False),(24:23-24:30,ExpBox False),(24:35-24:37,ExpBox False),(24:47-24:47,ExpBox False),(24:49-24:49,ExpBox False),(24:42-24:49,ExpBox False),(24:54-24:56,ExpBox False),(24:42-24:56,ExpBox False),(24:35-24:56,ExpBox False),(24:23-24:56,ExpBox True),(24:3-24:56,ExpBox False),(23:21-24:56,ExpBox False),(23:11-24:56,ExpBox False),(23:3-24:56,ExpBox False),(22:1-27:23,TopLevelBox ["showRecip"]),(30:13-30:18,ExpBox False),(31:23-31:28,ExpBox False),(31:12-31:29,ExpBox False),(31:3-31:29,ExpBox False),(32:3-32:6,ExpBox False),(29:8-32:6,ExpBox False),(29:1-32:6,TopLevelBox ["main"])]
\ No newline at end of file
diff --git a/test/ShowTix/input/Recip/Recip.hs b/test/ShowTix/input/Recip/Recip.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7571580073dcbe8fdec899e516b0db1556c25c74
--- /dev/null
+++ b/test/ShowTix/input/Recip/Recip.hs
@@ -0,0 +1,33 @@
+module Main where
+
+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
+
diff --git a/test/ShowTix/input/Recip/Recip.tix b/test/ShowTix/input/Recip/Recip.tix
new file mode 100644
index 0000000000000000000000000000000000000000..e71cea5cd60fb58d936ef83f3178bd5464795740
--- /dev/null
+++ b/test/ShowTix/input/Recip/Recip.tix
@@ -0,0 +1 @@
+Tix [ TixModule "Main" 1606722211 119 [7,7,2,5,7,2,5,0,5,5,5,5,5,5,7,12,12,12,12,12,9,11,11,10,11,11,11,14,2,12,14,2,2,2,2,2,12,12,1,11,12,1,1,1,1,11,11,11,0,11,11,11,11,11,11,11,14,3,3,3,3,3,3,3,0,3,3,3,3,3,3,3,3,0,0,0,0,0,3,3,3,2,2,2,2,2,3,3,3,3,3,3,1,2,3,1,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,1,3,3,3,3,1,1]]
diff --git a/test/Sum/Tests.hs b/test/Sum/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..8f66fdfcb484d01d0f7002c71a268c29cf1d9a61
--- /dev/null
+++ b/test/Sum/Tests.hs
@@ -0,0 +1,25 @@
+module Sum.Tests (sumTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+inputBaseDir :: FilePath
+inputBaseDir = FP.joinPath ["test", "Sum", "input"]
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "Sum", "gold"]
+
+-- | Tests of the "hpc sum" subcommand
+sumTests :: TestTree
+sumTests = testGroup "sum" [helpTextTest]
+
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help sum"]
diff --git a/test/Sum/gold/Help.stdout b/test/Sum/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..add5d0a9ff28f4f93aad6e4888dc22090e1c15cb
--- /dev/null
+++ b/test/Sum/gold/Help.stdout
@@ -0,0 +1,13 @@
+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)
+    --verbosity=[0-2]             verbosity level, 0-2
+                                  default 1
+
diff --git a/test/Utils.hs b/test/Utils.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ab124d09f3eb2e2b3cf596e51e4ff1bb62dccaed
--- /dev/null
+++ b/test/Utils.hs
@@ -0,0 +1,12 @@
+module Utils (runCommands) where
+
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Data.List (intercalate)
+import System.Process
+    ( readCreateProcess, shell, CreateProcess(cwd) )
+
+runCommands :: FilePath -> [String] -> IO BS.ByteString
+runCommands dir cmds = do
+    let combinedCmds = intercalate " && " cmds
+    out <- readCreateProcess ((shell combinedCmds ) { cwd = Just dir }) ""
+    pure (BS.fromString out)
diff --git a/test/Version/Tests.hs b/test/Version/Tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a25cb8ef8fb3279bb962d2d1eedc44b2511e8166
--- /dev/null
+++ b/test/Version/Tests.hs
@@ -0,0 +1,29 @@
+module Version.Tests (versionTests) where
+
+import qualified System.FilePath as FP
+import Test.Tasty (TestTree, testGroup)
+import qualified Data.ByteString.Lazy.UTF8 as BS
+import Test.Tasty.Golden (goldenVsString)
+import Utils (runCommands)
+
+
+goldBaseDir :: FilePath
+goldBaseDir = FP.joinPath ["test", "Version", "gold"]
+
+
+-- | Tests for the `hpc version` subcommand
+versionTests :: TestTree
+versionTests = testGroup "version" [versionTest, helpTextTest]
+
+versionTest :: TestTree
+versionTest = goldenVsString "Version" (goldBaseDir FP.</> "Version.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc version"]
+
+helpTextTest :: TestTree
+helpTextTest = goldenVsString "Help" (goldBaseDir FP.</> "Help.stdout") go
+  where
+    go :: IO BS.ByteString
+    go = runCommands "." ["hpc help version"]
+
diff --git a/test/Version/gold/Help.stdout b/test/Version/gold/Help.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..38e62c79ac7d8c90ddcd9e535feb57144664c875
--- /dev/null
+++ b/test/Version/gold/Help.stdout
@@ -0,0 +1,3 @@
+Usage: hpc version 
+Display version for hpc
+
diff --git a/test/Version/gold/Version.stdout b/test/Version/gold/Version.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..8d45ee44450fa6112322f6ea3c10e1fdc2ad6b0d
--- /dev/null
+++ b/test/Version/gold/Version.stdout
@@ -0,0 +1 @@
+hpc tools, version 0.69