test-lib (empty) → 0.1.0.0
raw patch · 5 files changed
+323/−0 lines, 5 filesdep +HUnitdep +basedep +containerssetup-changed
Dependencies added: HUnit, base, containers, directory, filepath, process, simple-get-opt, test-framework, test-framework-hunit
Files
- CHANGELOG.md +5/−0
- LICENSE +13/−0
- Setup.hs +2/−0
- src/TestLib.hs +274/−0
- test-lib.cabal +29/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for test-lib++## 0.1.0.0 -- 2018-12-11++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2018 Iavor Diatchki++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/TestLib.hs view
@@ -0,0 +1,274 @@+module TestLib (Config(..), mainWith) where++import SimpleGetOpt+import Control.Monad (foldM,when)+import System.Directory ( getDirectoryContents,doesDirectoryExist+ , createDirectoryIfMissing,canonicalizePath )+import System.Environment (withArgs)+import System.FilePath((</>),(<.>),splitFileName,splitDirectories,takeFileName+ , isRelative, pathSeparator )+import System.Process ( createProcess,CreateProcess(..), StdStream(..)+ , proc, waitForProcess, readProcessWithExitCode+ )+import System.IO(IOMode(..),withFile,Handle,hSetBuffering,BufferMode(..))+import System.Exit(exitSuccess)+import Test.Framework (defaultMain,Test,testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (assertFailure)+import qualified Control.Exception as X+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+++-- | Specifies how the test runner should behave.+data Config = Config+ { cfgDefaultBinary :: String+ -- ^ Use this binary unless one is explicitly provided.++ , cfgBinOpts :: String -> [String]+ -- ^ Given a test, produce a set of parameters for the binary.++ , cfgIsTestCase :: String -> Bool+ -- ^ Examine a file name to determine if it is a test.+ }++-- | Define a @main@ function for an executable.+mainWith :: Config -> IO ()+mainWith cfg =+ do let optSpec = options cfg+ opts <- getOpts optSpec++ when (optHelp opts) $+ do dumpUsage optSpec+ exitSuccess++ -- Normalize paths+ bin' <- if pathSeparator `elem` optBinary opts+ && isRelative (optBinary opts)+ then canonicalizePath (optBinary opts)+ else return (optBinary opts)+ resultsDir <- canonicalizePath (optResultDir opts)+ let opts' = opts { optResultDir = resultsDir, optBinary = bin' }++ createDirectoryIfMissing True resultsDir+ testFiles <- findTests opts'+ withArgs (optOther opts') (defaultMain (generateTests opts' testFiles))+++-- Command Line Options --------------------------------------------------------++data Options = Options+ { optBinary :: String+ , optOther :: [String]+ , optHelp :: Bool+ , optResultDir :: FilePath+ , optTests :: [FilePath]+ , optDiffTool :: Maybe String+ , optIgnoreExpected :: Bool+ , optCfg :: Config+ }+++options :: Config -> OptSpec Options+options cfg = OptSpec+ { progDefaults = Options { optBinary = cfgDefaultBinary cfg+ , optOther = []+ , optHelp = False+ , optResultDir = "output"+ , optTests = []+ , optDiffTool = Nothing+ , optIgnoreExpected = False+ , optCfg = cfg+ }++ , progOptions =+ [ Option "c" ["exe"]+ "the binary executable to use"+ $ ReqArg "PATH" $ \s o -> Right o { optBinary = s }++ , Option "r" ["result-dir"]+ "the result directory for test runs"+ $ ReqArg "PATH" $ \s o -> Right o { optResultDir = s }++ , Option "p" ["diff-prog"]+ "use this diffing program on failures"+ $ ReqArg "PROG" $ \s o -> Right o { optDiffTool = Just s }++ , Option "T" []+ "add an argument to pass to the test-runner main"+ $ ReqArg "STRING" $ \s o -> Right o { optOther = s : optOther o }++ , Option "i" ["ignore-expected"]+ "ignore expected failures"+ $ NoArg $ \o -> Right o { optIgnoreExpected = True }++ , Option "h" ["help"]+ "display this message"+ $ NoArg $ \o -> Right o { optHelp = True }+ ]++ , progParamDocs =+ [ ("FILES/DIRS", "The tests to run.") ]++ , progParams = \p o -> Right o { optTests = p : optTests o }+ }++-- Test Generation -------------------------------------------------------------++-- | Turn a directory tree of tests into a collection of tests.+-- Tests in the same directory share a test-group.+generateTests :: Options -> TestFiles -> [Test]+generateTests opts = loop ""+ where+ loop dir tests = as ++ grouped+ where+ as = map (generateAssertion opts dir) (Set.toList (files tests))+ grouped = [ testGroup path (loop (dir </> path) t)+ | (path,t) <- Map.toList (subDirs tests) ]++++-- | This is how we run a test.+generateAssertion :: Options -> FilePath -> FilePath -> Test+generateAssertion opts dir file = testCase file runTest+ where+ -- file locations:+ resultDir = optResultDir opts </> dir -- test output goes here+ goldFile = dir </> file <.> "stdout" -- what we expect to see+ knownFailureFile = dir </> file <.> "fails" -- expected failur+ resultOut = resultDir </> file <.> "stdout" -- outputfile++ runTest =+ do createDirectoryIfMissing True resultDir+ withFile resultOut WriteMode $ \ hout ->+ do hSetBuffering hout NoBuffering+ runBinary opts hout dir file++ out <- readFile resultOut+ expected <- readFile goldFile+ mbKnown <- X.try (readFile knownFailureFile)+ checkOutput mbKnown expected out++ checkOutput mbKnown expected out+ | expected == out =+ case mbKnown of+ Left _ -> return ()+ -- Test passed, but we expected a failure.+ Right _ ->+ assertFailure $+ "Test completed successfully. Please remove " ++ knownFailureFile+++ -- Gold and output differ+ | otherwise =+ case mbKnown of++ -- No expected errors.+ Left (X.SomeException {})++ -- A custom diff tool was lister. We don't run it,+ -- we just write it on the terminal for easy copy and paste.+ | Just prog <- optDiffTool opts ->+ do goldFile' <- canonicalizePath goldFile+ assertFailure $ unlines+ [ unwords [ prog, goldFile', "\\\n ", resultOut ]+ , makeGold resultOut goldFile'+ ]++ -- Just use "diff"+ | otherwise ->+ do goldFile' <- canonicalizePath goldFile+ (_,diffOut,_) <-+ readProcessWithExitCode "diff" [ goldFile', resultOut ] ""+ assertFailure $ unlines [ diffOut, makeGold resultOut goldFile' ]++ Right fail_msg+ -- Expected error.+ | optIgnoreExpected opts -> return ()+ -- Different expected error.+ | otherwise -> assertFailure fail_msg++ makeGold out gold =+ unlines [ "# If output is OK:"+ , unwords [ "cp", out, "\\\n ", gold ]+ ]++++-- | Write the output of stdout and stderr for a run of the binary to+-- the given handle.+runBinary :: Options -> Handle -> FilePath -> String -> IO ()+runBinary opts hout path file =+ do let bin = optBinary opts+ args = cfgBinOpts (optCfg opts) file+ (_, _, _, ph) <- createProcess (proc bin args)+ { cwd = Just path+ , std_out = UseHandle hout+ , std_in = Inherit+ , std_err = UseHandle hout+ }+ _ <- waitForProcess ph+ return ()+++++-- Test Discovery --------------------------------------------------------------++-- | Directory structure of the discovered tests. Each entry in the map+-- represents a single folder, with the top-level list representing tests+-- inside the base directory.+data TestFiles = TestFiles+ { subDirs :: Map String TestFiles+ , files :: Set String+ }++-- | An empty collection of tests.+noTests :: TestFiles+noTests = TestFiles { subDirs = Map.empty, files = Set.empty }++-- | Join two collections of tests, removing duplicates.+joinTests :: TestFiles -> TestFiles -> TestFiles+joinTests ts1 ts2 = TestFiles+ { files = Set.union (files ts1) (files ts2)+ , subDirs = Map.unionWith joinTests (subDirs ts1) (subDirs ts2)+ }++-- | Create a test collection with a single file.+testFile :: FilePath -> TestFiles+testFile path = foldr addDir baseTest dirs+ where+ baseTest = noTests { files = Set.singleton file }+ (dir,file) = splitFileName path+ dirs = splitDirectories dir+ addDir d t = TestFiles (Map.singleton d t) Set.empty+++-- | Find a bunch of tests.+findTests :: Options -> IO TestFiles+findTests opts = searchMany noTests (optTests opts)+ where+ searchMany tests = foldM step tests++ step tests path =+ do isDir <- doesDirectoryExist path+ if isDir+ then do fs <- getDirectoryContents path+ searchMany tests [ path </> f | f <- fs, not (isDotFile f) ]+ else if isTestFile path+ then return $! joinTests (testFile path) tests+ else return tests++ isDotFile path = case path of+ '.' : _ -> True+ _ -> False++ isTestFile f = cfgIsTestCase (optCfg opts) (takeFileName f)++++++
+ test-lib.cabal view
@@ -0,0 +1,29 @@+name: test-lib+version: 0.1.0.0+synopsis: A library to make a quick test-runner script.+description: This library makes it easy to define an executable,+ which can find and run a bunch of tests for a binary.+license: ISC+license-file: LICENSE+author: Iavor Diatchki+maintainer: iavor.diatchki@gmail.com+category: Testing+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: TestLib+ build-depends: base >=4.12 && <4.13,+ directory >=1.3 && <1.4,+ filepath >=1.4 && <1.5,+ process >=1.6 && <1.7,+ containers >=0.6 && <0.7,+ HUnit,+ test-framework,+ test-framework-hunit,+ simple-get-opt++ ghc-options: -Wall+ default-language: Haskell2010