diff options
| -rw-r--r-- | test-framework/Test/Framework.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/test-framework/Test/Framework.hs b/test-framework/Test/Framework.hs index 158c489..e83d0de 100644 --- a/test-framework/Test/Framework.hs +++ b/test-framework/Test/Framework.hs @@ -21,7 +21,7 @@ module Test.Framework ( import Control.Monad (forM) import Control.Monad.Trans.State.Strict import Control.Monad.IO.Class -import Data.List (isInfixOf) +import Data.List (isInfixOf, intercalate) import Data.Maybe (isJust, mapMaybe, fromJust) import Data.String (fromString) import Data.Time.Clock @@ -64,10 +64,10 @@ testProperty :: String -> H.Property -> TestTree testProperty = HP filterTree :: Options -> TestTree -> Maybe TestTree -filterTree (Options { optsPattern = pat }) = go "" +filterTree (Options { optsPattern = pat }) = go [] where go path (Group collapse name trees) = - case mapMaybe (go (path++"/"++name)) trees of + case mapMaybe (go (name:path)) trees of [] -> Nothing trees' -> Just (Group collapse name trees') go path (Resource make free fun) = @@ -75,9 +75,11 @@ filterTree (Options { optsPattern = pat }) = go "" Nothing -> Nothing Just _ -> Just $ Resource make free (fromJust . go path . fun) go path hp@(HP name _) - | pat `isInfixOf` (path++"/"++name) = Just hp + | pat `isInfixOf` renderPath (name:path) = Just hp | otherwise = Nothing + renderPath comps = "^" ++ intercalate "/" (reverse comps) ++ "$" + computeMaxLen :: TestTree -> Int computeMaxLen = go 0 where @@ -136,7 +138,7 @@ printUsage = do ,"Options:" ," -h / --help Show this help" ," -p PATTERN Only tests whose path contains PATTERN are run. The path of a" - ," test looks like: '/group1/group2/testname'." + ," test looks like: '^group1/group2/testname$'." ," --hedgehog-replay '{skip} {seed}'" ," Skip to a particular generated Hedgehog test. Should be used" ," with -p. Overrides 'propertySkip' in 'PropertyConfig' if set."] |