tasty-sugar-0.2.0.0: test/TestWildcard.hs
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| This test verifies behavior when the mkCUBE rootName is a generic
wildcard ("*") which will match everything in the target directory.
Proper tasty-sugar behavior will check for the expected and
associated files and identify those as associated test files *not*
include those as input rootFiles.
-}
module TestWildcard ( wildcardAssocTests ) where
import Data.List
import System.FilePath ( (</>) )
import qualified Test.Tasty as TT
import Test.Tasty.HUnit
import Test.Tasty.Sugar
import TestUtils
import Text.RawString.QQ
testInpPath = "test/samples"
sample1 = lines [r|
foo
foo.exp
foo.ex
bar.exp
bar.
bar-ex
cow.moo
cow.mooexp
cow.mooex
cow.mooexe
readme.txt
dog.bark
dog.bark-exp
|]
wildcardAssocTests :: [TT.TestTree]
wildcardAssocTests =
[ testCase "valid sample" $ 14 @=? length sample1
-- The first CUBE uses the default set of separators, and the expected
-- suffix does not limit which separators can preceed the suffix.
, TT.testGroup "with default seps" $
let sugarCube = mkCUBE
{ rootName = "*"
, expectedSuffix = "exp"
, inputDir = testInpPath
, associatedNames = [ ("extern", "ex") ]
}
p = (testInpPath </>)
in [ sugarTestEq "correct found count" sugarCube sample1 5 length
-- foo.ex is an associated name for foo, but removing its
-- extension makes it a sibling for the expected file and
-- therefore a valid root as well.
, sugarTestEq "foo is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "foo" ]
, sugarTestEq "foo.ex is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]
-- Similarly, bar.ex is an associated name, but also
-- matches the expected Suffix when its .ex suffix is
-- removed.
, sugarTestEq "bar. is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "bar." ]
, sugarTestEq "bar-ex is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "bar-ex" ]
, sugarTestEq "dog.bark is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootFile x == p "dog.bark" ]
-- n.b. cow.moo is not matched because there is no separator in cow.mooexp
, testCase "full results" $
compareBags "default result"
(fst $ findSugarIn sugarCube sample1) $
let p = (testInpPath </>) in
[
Sweets { rootMatchName = "foo"
, rootBaseName = "foo"
, rootFile = p "foo"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "foo.exp"
, expParamsMatch = []
, associated = [ ("extern", p "foo.ex") ]
}
]
}
, Sweets { rootMatchName = "foo.ex"
, rootBaseName = "foo"
, rootFile = p "foo.ex"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "foo.exp"
, expParamsMatch = []
, associated = []
}
]
}
, Sweets { rootMatchName = "bar."
, rootBaseName = "bar"
, rootFile = p "bar."
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "bar.exp"
, expParamsMatch = []
, associated = [ ("extern", p "bar-ex") ]
}
]
}
, Sweets { rootMatchName = "bar-ex"
, rootBaseName = "bar"
, rootFile = p "bar-ex"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "bar.exp"
, expParamsMatch = []
, associated = []
}
]
}
, Sweets { rootMatchName = "dog.bark"
, rootBaseName = "dog.bark"
, rootFile = p "dog.bark"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "dog.bark-exp"
, expParamsMatch = []
, associated = []
}
]
}
]
]
-- The second CUBE specifies no separators: the expected suffix
-- immediately follows the source name with no separator.
, TT.testGroup "no seps" $
let sugarCube = mkCUBE
{ rootName = "*"
, expectedSuffix = "exp"
, separators = ""
, inputDir = testInpPath
, associatedNames = [ ("extern", "ex") ]
}
p = (testInpPath </>)
in [ sugarTestEq "correct found count" sugarCube sample1 2 length
, sugarTestEq "bar is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootFile x == p "bar." ]
, sugarTestEq "cow.moo is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootFile x == p "cow.moo" ]
-- n.b. neither foo nor dog.bark is matched because they
-- both have a character between the name and the
-- expectedSuffix that is not a known separator
, testCase "full results" $
compareBags "default result"
(fst $ findSugarIn sugarCube sample1) $
let p = (testInpPath </>) in
[
Sweets { rootMatchName = "bar."
, rootBaseName = "bar."
, rootFile = p "bar."
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "bar.exp"
, expParamsMatch = []
, associated = []
}
]
}
, Sweets { rootMatchName = "cow.moo"
, rootBaseName = "cow.moo"
, rootFile = p "cow.moo"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "cow.mooexp"
, expParamsMatch = []
, associated = [ ("extern", p "cow.mooex") ]
}
]
}
]
]
-- The third CUBE specifies one of the separators as part of the
-- suffix, so only that separator is matched.
, TT.testGroup "seps with suffix sep" $
let sugarCube = mkCUBE
{ rootName = "*"
, expectedSuffix = ".exp"
, inputDir = testInpPath
, associatedNames = [ ("extern", "ex") ]
}
p = (testInpPath </>)
in [ sugarTestEq "correct found count" sugarCube sample1 4 length
-- see notes for default seps tests above
, sugarTestEq "foo is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "foo" ]
, sugarTestEq "foo.ex is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]
-- n.b. dog.bark is not matched because the separator in
-- dog.bark-exp is not the separator specified for the
-- expected suffix.
, sugarTestEq "bar. is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "bar." ]
, sugarTestEq "bar-ex is a case" sugarCube sample1 1 $
\sugar -> length [ x | x <- sugar, rootMatchName x == "bar-ex" ]
-- n.b. cow.moo is not matched because there is no separator in cow.mooexp
, testCase "full results" $
compareBags "default result"
(fst $ findSugarIn sugarCube sample1) $
let p = (testInpPath </>) in
[
Sweets { rootMatchName = "foo"
, rootBaseName = "foo"
, rootFile = p "foo"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "foo.exp"
, expParamsMatch = []
, associated = [ ("extern", p "foo.ex") ]
}
]
}
, Sweets { rootMatchName = "foo.ex"
, rootBaseName = "foo"
, rootFile = p "foo.ex"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "foo.exp"
, expParamsMatch = []
, associated = []
}
]
}
, Sweets { rootMatchName = "bar."
, rootBaseName = "bar"
, rootFile = p "bar."
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "bar.exp"
, expParamsMatch = []
, associated = [ ("extern", p "bar-ex") ]
}
]
}
, Sweets { rootMatchName = "bar-ex"
, rootBaseName = "bar"
, rootFile = p "bar-ex"
, cubeParams = []
, expected =
[ Expectation
{ expectedFile = p "bar.exp"
, expParamsMatch = []
, associated = []
}
]
}
]
]
]