tasty-sugar 2.0.1.0 → 2.1.0.0
raw patch · 7 files changed
+77/−21 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Test.Tasty.Sugar: distinctResults :: [Sweets] -> [Sweets]
Files
- CHANGELOG.md +9/−0
- src/Test/Tasty/Sugar.hs +17/−0
- src/internal/Test/Tasty/Sugar/Analysis.hs +10/−10
- src/internal/Test/Tasty/Sugar/ExpectCheck.hs +9/−6
- tasty-sugar.cabal +8/−2
- test/TestMain.hs +1/−1
- test/TestWildcard.hs +23/−2
CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for tasty-sugar +## 2.1.0.0 -- 2023-03-20++ * Now supports the ability for the expected file to have the same name as the+ root file. This is a trivial match, but still allows for capture of+ parameters and associated files. Major version bump because this may result+ in additional, unexpected matches; to get the original behavior use the (new)+ `distinctResults` modifier on the `findSugar` results.+ * Support for GHC 9.6+ ## 2.0.1.0 -- 2023-01-09 * Support for GHC 9.4.
src/Test/Tasty/Sugar.hs view
@@ -65,6 +65,7 @@ -- * Test Generation Functions , findSugar , findSugarIn+ , distinctResults , withSugarGroups -- * Types@@ -298,6 +299,22 @@ i2 <- choose [0..ll-1] guard (i1 /= i2) return (lst !! i1, lst !! i2)+++-- | Removes any sweets results where the expected file matches the rootFile.+-- This is expected to be used as a wrapper to the 'findSugar' or 'findSugarIn'+-- functions.+--+-- This is a convenience function for client code that wants to ensure that the+-- rootFile is distinct from the expected file, which could not happen prior to+-- release 2.1.0.0 but can happen from that release onward when a rootName allows+-- the expectedSuffix.++distinctResults :: [Sweets] -> [Sweets]+distinctResults sweets =+ let isDistinct s e = rootFile s /= expectedFile e+ removeRootExp s = s { expected = filter (isDistinct s) (expected s) }+ in filter (not . null . expected) $ fmap removeRootExp sweets -- | The 'withSugarGroups' is the primary function used to run tests.
src/internal/Test/Tasty/Sugar/Analysis.hs view
@@ -60,16 +60,16 @@ let params = L.sort $ validParams pat combineExpRes (swts, expl) = bimap (swts :) (expl :) - roots = [( candidatePMatch rootF- , rootF { candidateFile =- -- truncate the candidateFile to the first separator- -- point preceeding parameter matches.- let i = fromEnum $ candidateMatchIdx rootF- l = length $ candidateFile rootF- e = l > 0 && last (candidateFile rootF) `elem` (separators pat)- t = if i == l && not e then i else i - 1- in take t (candidateFile rootF) }- )+ roots = [ ( candidatePMatch rootF+ , rootF { candidateFile =+ -- truncate the candidateFile to the first separator+ -- point preceeding parameter matches.+ let i = fromEnum $ candidateMatchIdx rootF+ l = length $ candidateFile rootF+ e = l > 0 && last (candidateFile rootF) `elem` (separators pat)+ t = if i == l && not e then i else i - 1+ in take t (candidateFile rootF) }+ ) , (candidatePMatch rootF, rootF) ]
src/internal/Test/Tasty/Sugar/ExpectCheck.hs view
@@ -39,6 +39,7 @@ $ observeIAll $ do guard (not $ null candidates) expectedSearch+ rootN matchPrefix rootPMatches seps params expSuffix o@@ -50,9 +51,8 @@ expSuffix = expectedSuffix pat sfxMatch = if null expSuffix then const True else (expSuffix `L.isSuffixOf`) candidates = filter possible allNames- possible f = and [ candidateFile matchPrefix `L.isPrefixOf` candidateFile f- , rootN /= f- ]+ possible f = candidateFile matchPrefix `L.isPrefixOf` candidateFile f+ mkSweet e = Just $ Sweets { rootMatchName = candidateFile rootN , rootBaseName = candidateFile matchPrefix@@ -96,7 +96,8 @@ -- Note that rootPVMatches may contain multiple entries for the same parameter -- value: the root file name may contain these duplications. The code here -- should be careful to check against each value instead of assuming just one.-expectedSearch :: CandidateFile+expectedSearch :: CandidateFile -- ^ actual root file+ -> CandidateFile -- ^ prefix of root file to consider -> [NamedParamMatch] -> Separators -> [ParameterPattern]@@ -104,7 +105,8 @@ -> [ (String, FileSuffix) ] -> [CandidateFile] -> LogicI Expectation-expectedSearch rootPrefix rootPVMatches seps params expSuffix assocNames allNames =+expectedSearch rootN rootPrefix rootPVMatches seps params expSuffix+ assocNames allNames = do let expMatch cf = and [ candidateMatchPrefix seps rootPrefix cf , candidateMatchSuffix seps expSuffix rootPrefix cf ]@@ -153,7 +155,8 @@ let pmatch = namedPMatches rAndeMatches pvals assocFiles <- getAssoc rootPrefix seps pmatch- assocNames allNames+ assocNames+ $ filter (rootN /=) allNames return $ Expectation { expectedFile = candidateToPath efile , associated = fmap candidateToPath <$> assocFiles , expParamsMatch = L.sort pmatch
tasty-sugar.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: tasty-sugar-version: 2.0.1.0+version: 2.1.0.0 synopsis: Tests defined by Search Using Golden Answer References description: .@@ -25,7 +25,13 @@ category: Testing build-type: Simple -tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.1 GHC ==9.2.3 GHC ==9.4.4+tested-with: GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.1+ , GHC == 9.2.3+ , GHC == 9.4.4+ , GHC == 9.6.1 extra-source-files: CHANGELOG.md README.org
test/TestMain.hs view
@@ -18,6 +18,7 @@ import Data.Text.Prettyprint.Doc #endif +import TestFileSys import TestGCD import TestMultiAssoc import TestNoAssoc@@ -26,7 +27,6 @@ import TestStrlen2 import TestUtils import TestWildcard-import TestFileSys main :: IO ()
test/TestWildcard.hs view
@@ -74,7 +74,7 @@ , cubeParams = [] , expected = e }- in [ sugarTestEq "correct found count" sugarCube sample1 5 length+ in [ sugarTestEq "correct found count" sugarCube sample1 9 length -- foo.ex is an associated name for foo, but removing its -- extension makes it a sibling for the expected file and@@ -104,7 +104,23 @@ , sw "bar." "bar" "bar." [ expE "bar.exp" "bar-ex" ] , sw "bar-ex" "bar" "bar-ex" [ exp "bar.exp" ] , sw "dog.bark" "dog.bark" "dog.bark" [ exp "dog.bark-exp" ]+ -- rootName is a wildcard, so the expected can match the root:+ , sw "bar.exp" "bar" "bar.exp" [ expE "bar.exp" "bar-ex" ]+ , let r = "dog.bark-exp" in sw r "dog.bark" r [ exp r ]+ , sw "foo.exp" "foo" "foo.exp" [ expE "foo.exp" "foo.ex" ]+ , let r = "foo.right.exp" in sw r "foo.right" r [ exp r ] ]++ , testCase "full distinct results" $+ compareBags "default result"+ (distinctResults $ fst $ findSugarIn sugarCube (sample1 sugarCube)) $+ let p = (testInpPath </>) in+ [ sw "foo" "foo" "foo" [ expE "foo.exp" "foo.ex" ]+ , sw "foo.ex" "foo" "foo.ex" [ exp "foo.exp" ]+ , sw "bar." "bar" "bar." [ expE "bar.exp" "bar-ex" ]+ , sw "bar-ex" "bar" "bar-ex" [ exp "bar.exp" ]+ , sw "dog.bark" "dog.bark" "dog.bark" [ exp "dog.bark-exp" ]+ ] ] -- The second CUBE specifies no separators: the expected suffix@@ -168,7 +184,7 @@ , cubeParams = [] , expected = e }- in [ sugarTestEq "correct found count" sugarCube sample1 4 length+ in [ sugarTestEq "correct found count" sugarCube sample1 7 length -- see notes for default seps tests above @@ -195,6 +211,11 @@ , sw "foo.ex" "foo" "foo.ex" [ exp "foo.exp" ] , sw "bar." "bar" "bar." [ expE "bar.exp" "bar-ex" ] , sw "bar-ex" "bar" "bar-ex" [ exp "bar.exp" ]++ -- rootName is a wildcard, so the expected can match the root:+ , sw "bar.exp" "bar" "bar.exp" [ expE "bar.exp" "bar-ex" ]+ , sw "foo.exp" "foo" "foo.exp" [ expE "foo.exp" "foo.ex" ]+ , let r = "foo.right.exp" in sw r "foo.right" r [ exp r ] ] ]