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