test-karya 0.0.1 → 0.0.2

raw patch · 6 files changed

+83/−17 lines, 6 filesdep ~base

Dependency ranges changed: base

Files

• README.md +1/−1
• src/EL/Private/Cpu.hs +41/−0
• src/EL/Test/RunTests.hs +35/−13
• src/EL/Test/Testing.hs +1/−1
• src/Global.hs +2/−0
• test-karya.cabal +3/−2

@@ -64,7 +64,7 @@  - Make `RunTests.hs` with `{-# OPTIONS_GHC -F -pgmF test-karya-generate #-}` -- Make a `test-suite` like in `example`.+- Add a `test-suite` stanza to the cabal file, like in `example`.  - `cabal test`.  You can rerun the tests with `dist/build/test/test`, run only `M_test` with `dist/build/test/test M_test` or pass `--help` for more

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Get info about CPUs.+module EL.Private.Cpu where+import qualified Data.Set as Set+import qualified Data.Text as Text+import Data.Text (Text)+import qualified Data.Text.IO as Text.IO++import qualified System.Environment as Environment+import qualified System.Info+import qualified System.Process as Process++import qualified Text.Read as Read+++-- | Get number of physical cores.  This can be overidden with a CPUS+-- environment variable.  This is useful if you are running on a VM in CI+-- and don't agree with how many cores it claims to have.+physicalCores :: IO Int+physicalCores = maybe getPhysicalCores return =<< envCores++getPhysicalCores :: IO Int+getPhysicalCores = case System.Info.os of+    "darwin" -> read <$>+        Process.readProcess "/usr/sbin/sysctl" ["-n", "hw.physicalcpu"] ""+    "linux" -> linuxPhysicalCores <$> Text.IO.readFile "/proc/cpuinfo"+    _ -> error $ "unknown platform: " ++ System.Info.os++envCores :: IO (Maybe Int)+envCores = (Read.readMaybe =<<) <$> Environment.lookupEnv "CPUS"++-- | Parse /proc/cpuinfo for physical cpu count.+linuxPhysicalCores :: Text -> Int+linuxPhysicalCores = length . unique . map cpu . Text.splitOn "\n\n"+    where+    -- unique pairs of (physical id, core id)+    cpu = filter (\s -> any (`Text.isPrefixOf` s) ["physical id", "core id"])+        . Text.lines++unique :: Ord a => [a] -> [a]+unique = Set.toList . Set.fromList

@@ -5,7 +5,6 @@ -- | Run tests.  This is meant to be invoked via a main module generated by -- "EL.Test.GenerateRunTests". module EL.Test.RunTests where-import qualified Control.Concurrent as Concurrent import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.Chan as Chan import qualified Control.Concurrent.MVar as MVar@@ -14,6 +13,7 @@  import qualified Data.List as List import qualified Data.Maybe as Maybe+import Data.Monoid ((<>)) import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -33,6 +33,7 @@  import qualified Text.Read as Read +import qualified EL.Private.Cpu as Cpu import qualified EL.Private.File as File import qualified EL.Private.Process as EL.Process import qualified EL.Private.Regex as Regex@@ -89,7 +90,7 @@         \ This is probably just for cabal, which can't wrap tests in a shell\         \ script."     , GetOpt.Option [] ["jobs"] (GetOpt.ReqArg (Jobs . parseJobs) "1")-        "Number of parallel jobs, or 'auto' for Concurrent.getNumCapabilities."+        "Number of parallel jobs, or 'auto' for physical CPU count."     , GetOpt.Option [] ["list"] (GetOpt.NoArg List) "display but don't run"     , GetOpt.Option [] ["output"] (GetOpt.ReqArg Output "path")         "Path to a directory to put output logs, if not given output goes to\@@ -133,9 +134,9 @@     when (mbOutputDir == Nothing && CheckOutput `elem` flags) $         quitWithUsage [] ["--check-output requires --output"]     when (ClearDirs `elem` flags) $ do-        Directory.createDirectoryIfMissing True Testing.tmpBaseDir         clearDirectory Testing.tmpBaseDir         whenJust mbOutputDir clearDirectory+    Directory.createDirectoryIfMissing True Testing.tmpBaseDir     if  | List `elem` flags -> do             mapM_ Text.IO.putStrLn $ List.sort $ map testName $                 if null regexes then allTests else matches@@ -152,7 +153,7 @@  getJobs :: Jobs -> IO Int getJobs (NJobs n) = return n-getJobs Auto = Concurrent.getNumCapabilities+getJobs Auto = Cpu.physicalCores  runOutput :: FilePath -> Int -> [Test] -> Bool -> IO Bool runOutput outputDir jobs tests check = do@@ -307,7 +308,7 @@ -- | Empty the directory, but don't remove it entirely, in case it's /tmp or -- something. clearDirectory :: FilePath -> IO ()-clearDirectory dir = mapM_ rm =<< File.list dir+clearDirectory dir = void . File.ignoreEnoent $ mapM_ rm =<< File.list dir     where     -- Let's not go all the way to Directory.removePathForcibly.     rm fn = Directory.doesDirectoryExist fn >>= \isDir -> if isDir@@ -328,24 +329,45 @@ readFileEmpty = fmap (fromMaybe "") . File.ignoreEnoent . Text.Lazy.IO.readFile  extractStats :: Text.Lazy.Text -> ([Text], Int, Int, Int)+    -- ^ (failureContext, failures, checks, tests) extractStats = collect . drop 1 . Seq.split_before isTest . Text.Lazy.lines     where     collect tests = (failures, length failures, length extracted, length tests)         where         failures = Maybe.catMaybes extracted-        extracted = concatMap extractFailures tests+        extracted = concatMap (extractFailures . drop 1) tests     isTest = ((Text.Lazy.fromStrict (metaPrefix <> " run-test"))         `Text.Lazy.isPrefixOf`) --- | Collect lines before each failure for context.+-- | Collect lines before and after each failure for context.+--+-- I collect before because that's where debugging info about that test is+-- likely to show up, and I collect after because the failure output may+-- have multiple lines.+--+-- It can be confusing that I can get the failure lines of the previous test as+-- context for the current one.  To fix that I'd have to explicitly mark all+-- lines of the failure, or put some ending marker afterwards.  It's not hard+-- but maybe not worth it. extractFailures :: [Text.Lazy.Text] -> [Maybe Text]-extractFailures =-    mapMaybe fmt . Seq.split_after (\x -> isFailure x || isSuccess x)+    -- ^ Just context for a failure, Nothing for a success.+extractFailures = map convert . toChunks     where-    fmt lines-        | maybe False isFailure (Seq.last lines) =-            Just $ Just $ Text.Lazy.toStrict (Text.Lazy.unlines lines)-        | maybe False isSuccess (Seq.last lines) = Just Nothing+    convert (pre, test, post)+        | isFailure test = Just $ Text.Lazy.toStrict $ Text.Lazy.unlines $+            pre ++ [test] ++ post         | otherwise = Nothing+    toChunks [] = []+    toChunks lines+        | test == "" = []+        | otherwise = (pre, test, post) : toChunks rest2+        where+        (pre, rest1) = break isTest lines+        (test, rest2) = case rest1 of+            x : xs -> (x, xs)+            [] -> ("", [])+        post = takeWhile (not . isTest) rest2++    isTest s = isFailure s || isSuccess s     isFailure = ("__-> " `Text.Lazy.isPrefixOf`)     isSuccess = ("++-> " `Text.Lazy.isPrefixOf`)

@@ -102,7 +102,7 @@ checkVal :: Show a => HasCallStack => a -> (a -> Bool) -> IO Bool checkVal val f     | f val = success $ "ok: " <> pshowt val-    | otherwise = failure $ "failed:" <> pshowt val+    | otherwise = failure $ "failed: " <> pshowt val  -- * metadata 

@@ -1,5 +1,6 @@ module Global (     when, forever, unless, void, Map, mapMaybe, fromMaybe+    , (<>)     , Text, txt, untxt, showt     , whenJust, concatMapM ) where@@ -7,6 +8,7 @@ import Control.Monad (when, forever, unless, void) import Data.Map (Map) import Data.Maybe (mapMaybe, fromMaybe)+import Data.Monoid ((<>)) import qualified Data.Text as Text import Data.Text (Text) 

@@ -1,5 +1,5 @@ name: test-karya-version: 0.0.1+version: 0.0.2 cabal-version: >=1.10 build-type: Simple synopsis: Testing framework.@@ -33,7 +33,7 @@     build-depends:         Diff         , QuickCheck-        , base >= 4.9 && < 4.12+        , base >= 4.9 && < 5         , bytestring         , containers         , data-ordlist@@ -62,6 +62,7 @@     -- Now I just copy paste the dependencies between the library and the     -- executable as is traditional with cabal, and it seems to work.     other-modules:+        EL.Private.Cpu         EL.Private.ExtractHs         EL.Private.Map         EL.Private.PPrint