tasty-sugar 1.2.0.0 → 1.3.0.0
raw patch · 25 files changed
+2212/−554 lines, 25 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Test.Tasty.Sugar: CandidateFile :: FilePath -> [FilePath] -> FilePath -> CandidateFile
+ Test.Tasty.Sugar: [candidateDir] :: CandidateFile -> FilePath
+ Test.Tasty.Sugar: [candidateFile] :: CandidateFile -> FilePath
+ Test.Tasty.Sugar: [candidateSubdirs] :: CandidateFile -> [FilePath]
+ Test.Tasty.Sugar: [inputDirs] :: CUBE -> [FilePath]
+ Test.Tasty.Sugar: data CandidateFile
+ Test.Tasty.Sugar: getParamVal :: ParamMatch -> Maybe String
- Test.Tasty.Sugar: CUBE :: FilePath -> GlobPattern -> FileSuffix -> Separators -> [(String, FileSuffix)] -> [ParameterPattern] -> CUBE
+ Test.Tasty.Sugar: CUBE :: FilePath -> [FilePath] -> GlobPattern -> FileSuffix -> Separators -> [(String, FileSuffix)] -> [ParameterPattern] -> CUBE
- Test.Tasty.Sugar: findSugarIn :: CUBE -> [FilePath] -> ([Sweets], Doc ann)
+ Test.Tasty.Sugar: findSugarIn :: CUBE -> [CandidateFile] -> ([Sweets], Doc ann)
Files
- CHANGELOG.md +24/−0
- README.org +8/−6
- examples/example1/test-passthru-ascii.hs +1/−1
- examples/params/test-params.hs +1/−1
- src/Test/Tasty/Sugar.hs +60/−8
- src/internal/Test/Tasty/Sugar/Analysis.hs +67/−28
- src/internal/Test/Tasty/Sugar/AssocCheck.hs +28/−28
- src/internal/Test/Tasty/Sugar/ExpectCheck.hs +147/−78
- src/internal/Test/Tasty/Sugar/ParamCheck.hs +171/−14
- src/internal/Test/Tasty/Sugar/Report.hs +9/−0
- src/internal/Test/Tasty/Sugar/RootCheck.hs +88/−68
- src/internal/Test/Tasty/Sugar/Types.hs +77/−27
- tasty-sugar.cabal +3/−2
- test/Sample1.hs +14/−3
- test/TestFileSys.hs +1141/−0
- test/TestGCD.hs +7/−3
- test/TestMain.hs +53/−21
- test/TestMultiAssoc.hs +92/−89
- test/TestNoAssoc.hs +63/−63
- test/TestParamsAssoc.hs +14/−11
- test/TestSingleAssoc.hs +78/−78
- test/TestStrlen2.hs +29/−17
- test/TestUtils.hs +9/−2
- test/TestWildcard.hs +10/−6
- test/internals/test-internals.hs +18/−0
CHANGELOG.md view
@@ -1,5 +1,29 @@ # Revision history for tasty-sugar +## 1.3.0.0 -- 2022-06-28++ * Add `inputDirs` to `CUBE` to replace single `inputDir`. Allows test action+ files to be spread across various directories. The `inputDir` is still+ supported for backward-compatibility, but the `inputDirs` is preferred.++ * Any input directory can be specified with a trailing asterisk+ (e.g. "test/data/*") in which case all subdirectories of that root directory+ will be scanned.++ - Any file (root, expected, or associated) may come from any directory (the+ files in a single Sweet Expectation do not all need to occur in+ the same subdirectory).++ - The parameter matching will also consider subdirectory names (prioritized+ over filename parameter matches).++ * `SweetExplanation` `results` field is a single entry instead of an array.++ * Added `getParamVal` function to extract the value (if any) from any+ `ParamMatch`.++ * Fixed some bugs in filename analysis and parameter determination.+ ## 1.2.0.0 -- 2022-05-16 * Update for logict 0.8.0.0 breaking change.
README.org view
@@ -75,7 +75,7 @@ that. Setup the tasty-sugar CUBE configuration as follows: #+BEGIN_EXAMPLE- cube = mkCUBE { inputDir = "test/samples"+ cube = mkCUBE { inputDirs = [ "test/samples" ] , rootName = "*.c" , expectedSuffix = "exp" , associatedNames = [ ("binary", "") ]@@ -196,7 +196,7 @@ ~Tasty.Sugar.CUBE~ configuration: #+BEGIN_EXAMPLE- cube = mkCUBE { inputDir = "test/samples"+ cube = mkCUBE { inputDirs = [ "test/samples" ] , rootName = "*.exe" , expectedSuffix = "expct" , associatedNames = [ ("c-source", ".c")@@ -298,7 +298,7 @@ The ~Tasty.Sugar.CUBE~ confguration for is scenario is updated to: #+BEGIN_EXAMPLE- cube = mkCUBE { inputDir = "test/samples"+ cube = mkCUBE { inputDirs = [ "test/samples" ] , rootName = "*" , separators = "-." , expectedSuffix = "expct"@@ -430,8 +430,7 @@ * Limitations - * Huge directories- * Huge files+ * Huge numbers of directories or files will cause performance slowdowns * Will throw any exception that the listDirectory function can throw. * Detailed Information@@ -464,7 +463,7 @@ #+BEGIN_EXAMPLE CUBE =- { inputDir = "tests/samples" -- relative to cabal file+ { inputDirs = [ "tests/samples" ] -- relative to cabal file , separators = ".-" , rootName = "*.c" , associatedNames = [ ("exe", "exe")@@ -567,3 +566,6 @@ note that the set of all tests must be known *prior* to invoking the tasty main code; they cannot be added dynamically after that point).++ 3. Testing should be consistent: relying on user-input during+ testing would return different results for different input.
examples/example1/test-passthru-ascii.hs view
@@ -7,7 +7,7 @@ import NiftyText -cube = mkCUBE { inputDir = "examples/example1/testdata" }+cube = mkCUBE { inputDirs = [ "examples/example1/testdata" ] } main = do sweets <- findSugar cube
examples/params/test-params.hs view
@@ -7,7 +7,7 @@ cube :: CUBE-cube = mkCUBE { inputDir = "examples/params/samples"+cube = mkCUBE { inputDirs = [ "examples/params/samples" ] , rootName = "*.exe" , separators = "-." , expectedSuffix = "expct"
src/Test/Tasty/Sugar.hs view
@@ -25,7 +25,7 @@ -- > import Test.Tasty.Sugar -- > import Numeric.Natural -- >--- > sugarCube = mkCUBE { inputDir = "test/samples"+-- > sugarCube = mkCUBE { inputDirs = [ "test/samples", "test/expected" ] -- > , rootName = "*.c" -- > , associatedNames = [ ("inputs", "inp") ] -- > , expectedSuffix = "exp"@@ -52,7 +52,9 @@ -- -- See the README for more information. +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-} module Test.Tasty.Sugar (@@ -71,6 +73,7 @@ , Separators , ParameterPattern , mkCUBE+ , CandidateFile(..) -- ** Output , Sweets(..) , Expectation(..)@@ -78,6 +81,7 @@ , NamedParamMatch , ParamMatch(..) , paramMatchVal+ , getParamVal -- ** Reporting , sweetsKVITable , sweetsTextTable@@ -97,7 +101,11 @@ import Data.Typeable ( Typeable ) import Numeric.Natural ( Natural ) import Prettyprinter-import System.Directory ( listDirectory )+import System.Directory ( doesDirectoryExist, getCurrentDirectory+ , listDirectory, doesDirectoryExist )+import System.FilePath ( (</>), isRelative, makeRelative+ , splitPath, takeDirectory, takeFileName)+import System.IO ( hPutStrLn, stderr ) import Test.Tasty.Ingredients import Test.Tasty.Options @@ -168,10 +176,53 @@ findSugar cube = fst <$> findSugar' cube findSugar' :: MonadIO m => CUBE -> m ([Sweets], Doc ann)-findSugar' pat = findSugarIn pat <$> liftIO (listDirectory $ inputDir pat)+findSugar' pat =+ let collectDirEntries d =+ let recurse = takeFileName d == "*"+ top = if recurse then Just (takeDirectory d) else Nothing+ start = if recurse then takeDirectory d else d+ in dirListWithPaths top start+ dirListWithPaths topDir d =+ -- putStrLn ("Reading " <> show d) >>+ doesDirectoryExist d >>= \case+ True ->+ do dirContents <- listDirectory d+ case topDir of+ Nothing -> do+ let mkC f = CandidateFile { candidateDir = d+ , candidateSubdirs = []+ , candidateFile = f+ }+ return (mkC <$> dirContents)+ Just topdir -> do+ let subs = filter (not . null)+ (init+ <$> init (splitPath+ $ makeRelative topdir (d </> "x")))+ let mkC f = CandidateFile { candidateDir = topdir+ , candidateSubdirs = subs+ , candidateFile = f+ }+ subdirs <- filterM (doesDirectoryExist . (d </>)) dirContents+ let here = mkC <$> (filter (not . (`elem` subdirs)) dirContents)+ subCandidates <- mapM (dirListWithPaths topDir)+ ((d </>) <$> subdirs)+ return (here <> (concat subCandidates))+ False -> do+ showD <- case isRelative d of+ True -> do cwd <- getCurrentDirectory+ return $ "[" <> cwd <> "/]" <> d+ False -> return d+ hPutStrLn stderr $ "WARNING: " <> showD <> " does not exist"+ return []+ in findSugarIn pat+ <$> liftIO (concat <$> (mapM collectDirEntries+ $ L.filter (not . null)+ $ L.nub+ $ inputDir pat : inputDirs pat)) --- | Given a list of files and a CUBE, returns the list of matching+-- | Given a list of filepaths and a CUBE, returns the list of matching -- test Sweets that should be run, and an explanation of the search -- process (describing unmatched possibilities as well as valid test -- configurations).@@ -179,14 +230,15 @@ -- This is a low-level function; the findSugar and withSugarGroups are -- the recommended interface functions to use for writing tests. -findSugarIn :: CUBE -> [FilePath] -> ([Sweets], Doc ann)+findSugarIn :: CUBE -> [CandidateFile] -> ([Sweets], Doc ann) findSugarIn pat allFiles = let (nCandidates, sres) = checkRoots pat allFiles inps = concat $ fst <$> sres expl = vsep $- [ "Checking for test inputs in:" <+> pretty (inputDir pat)+ [ "Checking for test inputs in:" <+>+ pretty (L.nub $ inputDir pat : inputDirs pat) , indent 2 $- vsep $ [ "# files in directory =" <+>+ vsep $ [ "# files in directories =" <+> pretty (length allFiles) , "# root candidates matching" <+> dquotes (pretty (rootName pat)) <+> equals <+>@@ -197,7 +249,7 @@ ] <> ((("--?" <+>) . pretty) <$> (concatMap snd sres)) ] in case cubeIsValid pat of- Right _ -> (inps, expl)+ Right _ -> (L.sortBy (compare `on` rootFile) inps, expl) Left e -> error e -- this is just testing code, so error is fine where
src/internal/Test/Tasty/Sugar/Analysis.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+ -- | Main internal entry point for determining the various test -- configurations specified by a CUBE input. @@ -9,25 +11,30 @@ import Control.Monad.Logic import Data.Bifunctor ( bimap )+import Data.Function ( on )+import qualified Data.List as L import Data.Maybe ( catMaybes )-import qualified System.FilePath as FP+import Data.Ord ( comparing ) import qualified System.FilePath.GlobPattern as FPGP import Test.Tasty.Sugar.ExpectCheck import Test.Tasty.Sugar.RootCheck+import Test.Tasty.Sugar.ParamCheck ( pmatchCmp ) import Test.Tasty.Sugar.Types --- | Given a 'CUBE' and a list of files in the target directory,--- return all 'Sweets' matches along with an explanation of the search--- process. This is the core implementation for the--- 'Test.Tasty.Sugar.findSugar' API interface.-checkRoots :: CUBE -> [FilePath]+-- | Given a 'CUBE' and a list of candidate files in the target directories,+-- return all 'Sweets' matches along with an explanation of the search process.+-- This is the core implementation for the 'Test.Tasty.Sugar.findSugar' API+-- interface.+checkRoots :: CUBE -> [CandidateFile] -> (Int, [([Sweets], [SweetExplanation])]) checkRoots pat allFiles =- let isRootMatch n = n FPGP.~~ (rootName pat)- rootNames = FP.takeFileName <$> (filter isRootMatch allFiles)- in (length rootNames, fmap (checkRoot pat allFiles) rootNames)+ let isRootMatch n = candidateFile n FPGP.~~ (rootName pat)+ roots = filter isRootMatch allFiles+ checked = filter (not . null . fst)+ ((checkRoot pat allFiles) <$> roots)+ in (length checked, checked) -- checkRoot will attempt to split the identified root file into three@@ -40,31 +47,63 @@ -- expSuffix, and any param-values provided. A 'Sweets' will be -- returned for each expected file matching this root configuration checkRoot :: CUBE- -> [FilePath] -- all possible expect candidates- -> FilePath -- root name+ -> [CandidateFile] -- all possible expect candidates+ -> CandidateFile -- root path -> ([Sweets], [SweetExplanation])-checkRoot pat allNames rootNm =+checkRoot pat allFiles rootF = let seps = separators pat params = validParams pat combineExpRes (swts, expl) = bimap (swts :) (expl :) - trimSweets :: [(Sweets, SweetExplanation)] ->- [(Sweets, SweetExplanation)]- trimSweets =- -- If multiple Sweets have the same rootMatchName, use the one- -- with the longer rootBaseName. This prevents "foo.exp" and- -- "foo-bar.exp" from both matching "foo-bar.c".- (\l -> let removeShorterBases lst (entry,_) =- let notShorterBase (s,_) = not $- and [ rootMatchName s == rootMatchName entry- , rootBaseName s < rootBaseName entry- ]- in filter notShorterBase lst- in foldl removeShorterBases l l)+ mergeSweets swl =+ -- If multiple Sweets have the same rootMatchName this likely means that+ -- there were multiple expected files that could have matched. Merge the+ -- Expectations: for each of the second Sweet's expectations:+ --+ -- - If one has a longer rootBaseName, that one represents the more+ -- explicit match and should be used. Otherwise,+ --+ -- - If no explicit (expParamsMatch) elements match the first, this+ -- is a unique Expectation, add it to the first Sweet+ --+ -- - Find the Expectation in the first Sweet with the most number of+ -- Explicit matches, then select the one that has the most number of+ -- remaining Explicit that don't match the other (one should be a+ -- strict subset of the other!)+ let combineIfRootsMatch s sl =+ -- Add s to sl, or if s matches a root in sl, merge s with that sl+ uncurry (flip (:))+ ( combineSweets s <$> L.partition (not . isRootMatch s) sl)+ isRootMatch = (==) `on` (rootMatchName . fst)+ combineSweets s slm =+ -- Merge all the expectations from each of slm sweets into the main+ -- sweet s.+ foldr chooseOrCombineExpectations s slm+ chooseOrCombineExpectations (s,e) (sm,sme) =+ case comparing rootBaseName s sm of+ GT -> (s,e)+ LT -> (sm, sme)+ EQ -> bestExpectations (s,e) (sm,sme)+ bestExpectations (s,e) (sm,_sme) =+ -- combine the expectations in s with the expectations in each of+ -- sm, where expectations overlap based on explicit expParamsMatch+ -- matchups.+ let swts = s { expected =+ foldr mergeExp (expected s) (expected sm)+ }+ mergeExp oneExp exps =+ concat+ $ fmap (take 1)+ $ L.groupBy ((==) `on`+ (fmap (fmap getParamVal) . expParamsMatch))+ $ L.sortBy (pmatchCmp `on` expParamsMatch)+ $ oneExp : exps+ in ( swts, e { results = swts } )+ in foldr combineIfRootsMatch [] swl in foldr combineExpRes ([], []) $- trimSweets $+ mergeSweets $ catMaybes $- fmap (findExpectation pat rootNm allNames) $+ fmap (findExpectation pat rootF allFiles) $ observeAll $- rootMatch rootNm seps params (rootName pat)+ rootMatch rootF seps params (rootName pat)
src/internal/Test/Tasty/Sugar/AssocCheck.hs view
@@ -9,7 +9,6 @@ ) where -import Control.Monad import Control.Monad.Logic import qualified Data.List as L import Data.Maybe ( catMaybes )@@ -22,18 +21,18 @@ -- the rootMatch plus the named parameter values (in the same order -- but with any combination of separators) and the specified suffix -- match.-getAssoc :: FilePath+getAssoc :: CandidateFile -> Separators -> [NamedParamMatch] -> [ (String, FileSuffix) ]- -> [FilePath]- -> Logic [(String, FilePath)]+ -> [CandidateFile]+ -> Logic [(String, CandidateFile)] getAssoc rootPrefix seps pmatch assocNames allNames = assocSet where assocSet = concat <$> mapM fndBestAssoc assocNames fndBestAssoc :: (String, FileSuffix)- -> Logic [(String, FilePath)] -- usually just one+ -> Logic [(String, CandidateFile)] -- usually just one fndBestAssoc assoc = do let candidates = L.nub $ catMaybes $ observeAll (fndAnAssoc assoc)@@ -44,36 +43,37 @@ else return (snd <$> c) fndAnAssoc :: (String, FileSuffix)- -> Logic (Maybe (Int, (String, FilePath)))+ -> Logic (Maybe (Int, (String, CandidateFile))) fndAnAssoc assoc = ifte (fndAssoc assoc) (return . Just) (return Nothing) - fndAssoc :: (String, FileSuffix) -> Logic (Int, (String, FilePath))+ fndAssoc :: (String, FileSuffix) -> Logic (Int, (String, CandidateFile)) fndAssoc assoc = do pseq <- npseq pmatch (rank, assocPfx, assocSfx) <- sepParams seps (fmap snd pseq)- if null assocSfx- then do let assocNm = if null (snd assoc) &&- length assocPfx == 1 -- just a separator- then rootPrefix- else rootPrefix <> assocPfx <> (snd assoc)- guard (assocNm `elem` allNames)- return (rank, (fst assoc, assocNm))- else let assocStart = rootPrefix <> assocPfx- assocEnd = assocSfx <> snd assoc- aSL = length assocStart- aEL = length assocEnd- possible f =- and [ assocStart `L.isPrefixOf` f- , assocEnd `L.isSuffixOf` f- , length f > (aSL + aEL)- , let mid = drop aSL (take (length f - aEL) f)- in and $ fmap (not . flip elem mid) seps- ]- fnd = filter possible allNames- in do f <- eachFrom fnd- return (rank, (fst assoc, f))+ let possible =+ if null assocSfx+ then let justSep = null (snd assoc) && length assocPfx == 1+ rootNm = candidateFile rootPrefix+ assocFName = if justSep+ then rootNm+ else rootNm <> assocPfx <> (snd assoc)+ in (assocFName ==)+ else let assocStart = candidateFile rootPrefix <> assocPfx+ assocEnd = assocSfx <> snd assoc+ aSL = length assocStart+ aEL = length assocEnd+ chk f =+ and [ assocStart `L.isPrefixOf` f+ , assocEnd `L.isSuffixOf` f+ , length f > (aSL + aEL)+ , let mid = drop aSL (take (length f - aEL) f)+ in and $ fmap (not . flip elem mid) seps+ ]+ in chk+ f <- eachFrom $ filter (possible . candidateFile) allNames+ return (rank, (fst assoc, f)) sepParams :: Separators -> [ParamMatch] -> Logic (Int, String, String) sepParams sl =
src/internal/Test/Tasty/Sugar/ExpectCheck.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+ -- | Function to find expected results files for a specific root file, -- along with any parameter values identified by the root file. @@ -10,7 +13,6 @@ import Control.Monad import Control.Monad.Logic-import System.FilePath ( (</>) ) import qualified Data.List as L import Test.Tasty.Sugar.AssocCheck@@ -21,28 +23,32 @@ -- | Finds the possible expected files matching the selected -- source. There will be either one or none. findExpectation :: CUBE- -> FilePath -- original name of source- -> [FilePath] -- all of the names to choose from- -> ([NamedParamMatch], FilePath, FilePath) -- param constraints from the root name+ -> CandidateFile -- original name of source+ -> [CandidateFile] -- all of the names to choose from+ -> ([NamedParamMatch], CandidateFile, String) -- param constraints from the root name -> Maybe ( Sweets, SweetExplanation ) findExpectation pat rootN allNames (rootPMatches, matchPrefix, _) =- let r = mkSweet <$>+ let r = mkSweet $ trimExpectations $- observeAll $- expectedSearch d matchPrefix rootPMatches seps params expSuffix o- candidates- d = inputDir pat+ observeAll $+ do guard (not $ null candidates)+ expectedSearch+ matchPrefix+ rootPMatches seps params expSuffix o+ candidates++ o = associatedNames pat seps = separators pat params = validParams pat expSuffix = expectedSuffix pat candidates = filter possible allNames- possible f = and [ matchPrefix `L.isPrefixOf` f+ possible f = and [ candidateFile matchPrefix `L.isPrefixOf` candidateFile f , rootN /= f ]- mkSweet e = Just $ Sweets { rootMatchName = rootN- , rootBaseName = matchPrefix- , rootFile = inputDir pat </> rootN+ mkSweet e = Just $ Sweets { rootMatchName = candidateFile rootN+ , rootBaseName = candidateFile matchPrefix+ , rootFile = candidateToPath rootN , cubeParams = validParams pat , expected = e }@@ -67,37 +73,38 @@ Nothing -> Nothing Just r' | [] <- expected r' -> Nothing Just r' -> Just ( r'- , SweetExpl { rootPath = rootN- , base = matchPrefix+ , SweetExpl { rootPath = candidateToPath rootN+ , base = candidateToPath matchPrefix , expectedNames = filter (if null expSuffix then const True else (expSuffix `L.isSuffixOf`))- candidates- , results = [ r' ]+ (candidateToPath <$> candidates)+ , results = r' }) + -- Find all Expectations matching this rootMatch-expectedSearch :: FilePath- -> FilePath+expectedSearch :: CandidateFile -> [NamedParamMatch] -> Separators -> [ParameterPattern] -> FileSuffix -> [ (String, FileSuffix) ]- -> [FilePath]+ -> [CandidateFile] -> Logic Expectation-expectedSearch inpDir rootPrefix rootPVMatches seps params expSuffix assocNames allNames =- do (expFile, pmatch) <-- let bestRanked :: [(FilePath, Int, [NamedParamMatch])]- -> Logic (FilePath, [NamedParamMatch])+expectedSearch rootPrefix rootPVMatches seps params expSuffix assocNames allNames =+ do params' <- singlePVals rootPVMatches params+ (expFile, pmatch, assocFiles) <-+ let bestRanked :: (Eq a, Eq b, Eq c)+ => [((a, Int, [b]),c)] -> Logic (a, [b], c) bestRanked l = if null l then mzero else let m = maximum $ fmap rankValue l- rankValue (_,r,_) = r- rankMatching v (_,r,_) = v == r- dropRank (a,_,b) = (a,b)- in eachFrom $ fmap dropRank $ filter (rankMatching m) l+ rankValue ((_,r,_),_) = r+ rankMatching v ((_,r,_),_) = v == r+ dropRank ((a,_,b),c) = (a,b,c)+ in eachFrom $ L.nub $ fmap dropRank $ filter (rankMatching m) l in bestRanked $ observeAll $@@ -105,77 +112,139 @@ ([] :) $ filter (not . null) $ concatMap L.inits $- L.permutations params+ L.permutations params' pvals <- getPVals pseq- getExp rootPrefix rootPVMatches seps pvals expSuffix allNames- assocFiles <- getAssoc rootPrefix seps pmatch assocNames allNames- return $ Expectation { expectedFile = inpDir </> expFile- , associated = fmap (inpDir </>) <$> assocFiles- , expParamsMatch = pmatch+ let compatNames = filter (isCompatible seps params pvals) allNames+ guard (not $ null compatNames)+ e@(_,_,pmatch) <- getExp rootPrefix rootPVMatches seps params pvals+ expSuffix compatNames+ a <- (getAssoc rootPrefix seps pmatch assocNames compatNames)+ return (e,a)+ return $ Expectation { expectedFile = candidateToPath expFile+ , associated = fmap candidateToPath <$> assocFiles+ , expParamsMatch = L.sort pmatch } --- Get all expected files for a particular sequence of param+value.++-- | Get all expected files for a particular sequence of param+value. -- Returns the expected file, the sequence of parameter values that -- match that expect file, and a ranking (the number of those paramter -- values that actually appear in the expect file.-getExp :: FilePath+getExp :: CandidateFile -> [NamedParamMatch] -> Separators+ -> [ParameterPattern] -> [(String, Maybe String)] -> FileSuffix- -> [FilePath]- -> Logic (FilePath, Int, [NamedParamMatch])-getExp rootPrefix rootPMatches seps pvals expSuffix allNames =- do (pm, pmcnt, pmstr) <- pvalMatch seps rootPMatches pvals+ -> [CandidateFile]+ -> Logic (CandidateFile, Int, [NamedParamMatch])+getExp rootPrefix rootPMatches seps params pvals expSuffix allNames =+ do -- Some of the params may be encoded in the subdirectories instead of in the+ -- target filename (each param value could appear in either). If a+ -- rootPMatches value is in a subdirectory, no other values for that+ -- parameter can appear, otherwise all possible values could appear. A+ -- subset of the rootPMatches may appear in the subdirs, but only the+ -- maximal subset can be considered.++ let rootMatchesInSubdir :: CandidateFile -> [NamedParamMatch]+ rootMatchesInSubdir f =+ let chkRootMatch d r =+ let chkRPMatch p r' =+ case getExplicit $ snd p of+ Just v -> if d == v then p : r' else r'+ Nothing -> r'+ in foldr chkRPMatch r rootPMatches+ in foldr chkRootMatch mempty $ candidateSubdirs f++ let inpDirMatches = fmap rootMatchesInSubdir <$> zip allNames allNames++ (dirName, inpDirMatch) <- eachFrom inpDirMatches++ let nonRootMatchPVals = removePVals pvals inpDirMatch++ (otherMatchesInSubdir, _) <-+ dirMatches dirName params $ (fmap (fmap (:[])) <$> nonRootMatchPVals)++ let remPVals = removePVals nonRootMatchPVals otherMatchesInSubdir++ let remRootMatches = removePVals rootPMatches inpDirMatch+ let validNames = [ dirName ]++ (fp, cnt, npm) <- getExpFileParams rootPrefix+ remRootMatches+ seps remPVals expSuffix validNames+++ -- Corner case: a wildcard parameter could be selected from both a subdir+ -- and the filename... if the values are the same, that's OK, but if the+ -- values are different it should be rejected.++ let dpm = inpDirMatch <> otherMatchesInSubdir++ let conflict = let chkNPM (pn,pv) acc =+ acc || case lookup pn dpm of+ Nothing -> False+ Just v -> v /= pv+ in foldr chkNPM False npm+ guard (not conflict)++ return (fp, length dpm + cnt, dpm <> npm)+++getExpFileParams :: CandidateFile+ -> [NamedParamMatch]+ -> Separators+ -> [(String, Maybe String)]+ -> FileSuffix+ -> [CandidateFile]+ -> Logic (CandidateFile, Int, [NamedParamMatch])+getExpFileParams rootPrefix rootPMatches seps pvals expSuffix hereNames =+ do let suffixSpecifiesSep = and [ not (null expSuffix)+ , head expSuffix `elem` seps+ ]+ (pm, pmcnt, pmstr) <- pvalMatch seps rootPMatches pvals+ -- If the expSuffix starts with a separator then *only that* -- separator is allowed for the suffix (other seps are still -- allowed for parameter value separation).- let suffixSpecifiesSep = and [ not (null expSuffix)- , head expSuffix `elem` seps- ] let suffixSepMatch = not suffixSpecifiesSep || and [ not (null pmstr) , last pmstr == head expSuffix ] guard suffixSepMatch- let expFile = if suffixSpecifiesSep- then rootPrefix <> pmstr <> tail expSuffix- else rootPrefix <> pmstr <> expSuffix- guard (expFile `elem` allNames)- return (expFile, pmcnt, pm) + let ending = if suffixSpecifiesSep then tail expSuffix else expSuffix -removeNonExplicitMatchingExpectations :: [Expectation] -> [Expectation]-removeNonExplicitMatchingExpectations l =- let removeNonExplicits lst entry =- let (explParams, assumedParams) =- L.partition (isExplicit . snd) (expParamsMatch entry)+ expFile <-+ eachFrom+ $ filter (((candidateFile rootPrefix <> pmstr <> ending) ==) . candidateFile)+ $ hereNames - -- only return False if oneExp should be- -- removed: i.e. it is an Expectation that- -- matches all non-explicit parameters and- -- has non-explicit matches for any of the- -- Explicit matches.- nonExplMatch oneExp =- or [ oneExp == entry- , not $ all nonExplParamCheck $ expParamsMatch oneExp- ]+ return (expFile, pmcnt, pm) - -- return True if this parameter check would- -- allow removal of this Explicit based on- -- _this_ parameter.- nonExplParamCheck (pn, pv) =- case lookup pn explParams of- Just (Explicit ev) ->- case pv of- Assumed av -> ev == av- NotSpecified -> True- Explicit ev' -> ev == ev'- _ -> -- generally nothing; other Just values not possible from explParams- case lookup pn assumedParams of- Nothing -> False- Just av -> av == pv - in filter nonExplMatch lst+-- | Determines the best Expectations to use from a list of Expectations that may+-- have different parameter match status against an expected file. When two+-- Expectations differ only in an Explicit v.s. Assumed (or wildcard) the+-- Explicit is preferred. Expectations with more parameter matches are preferred+-- over those with less. - in foldl removeNonExplicits l l+removeNonExplicitMatchingExpectations :: [Expectation] -> [Expectation]+removeNonExplicitMatchingExpectations =+ let removeNonExplicits e l =+ let (similarExpl, diffExpl) = L.partition (cmpPVals e) l+ cmpPVals ref ps =+ -- Compare the two on the intersection subset of parameters+ if length (expParamsMatch ref) < length (expParamsMatch ps)+ then expPVals ref ref == expPVals ref ps+ else expPVals ps ps == expPVals ps ref+ expPVals ref ps =+ -- Compare parameters by comparing the values of matching names+ let ps' = expParamsMatch ps+ ref' = expParamsMatch ref+ refNames = fst <$> ref'+ in (\n -> lookup n ps' >>= getParamVal) <$> refNames+ in if null similarExpl+ then e : l+ else (pmatchMax expParamsMatch e <$> similarExpl) <> diffExpl+ in foldr removeNonExplicits mempty
src/internal/Test/Tasty/Sugar/ParamCheck.hs view
@@ -1,16 +1,28 @@+{-# LANGUAGE LambdaCase #-}+ -- | Functions for checking different parameter/value combinations. module Test.Tasty.Sugar.ParamCheck ( eachFrom , getPVals+ , singlePVals , pvalMatch+ , removePVals+ , pmatchCmp+ , pmatchMax+ , dirMatches+ , inEachNothing+ , isCompatible ) where import Control.Monad import Control.Monad.Logic+import Data.Function ( on ) import qualified Data.List as L+import Data.Maybe ( catMaybes, fromJust, isNothing, listToMaybe )+import Data.Bifunctor ( first ) import Data.Maybe ( fromMaybe ) import Test.Tasty.Sugar.Types@@ -30,6 +42,24 @@ getPVal (pn, Just pv) = do pv' <- eachFrom pv return (pn, Just pv') +-- | Returns a ParameterPattern admitting only a single value for each parameter,+-- ensuring that the value is compatible with any existing NamedParamMatch. This+-- is useful for callers wishing to handle each combination of parameter values+-- separately.+singlePVals :: [NamedParamMatch] -> [ParameterPattern]+ -> Logic [ParameterPattern]+singlePVals sel = eachVal . L.sort+ where eachVal [] = return []+ eachVal ((pn,Nothing):ps) =+ let this = (pn, (:[]) <$> (lookup pn sel >>= getParamVal))+ in (this :) <$> eachVal ps+ eachVal ((pn,Just pvs):ps) =+ do pv <- eachFrom $ case lookup pn sel >>= getParamVal of+ Nothing -> L.sort pvs+ Just v -> [v]+ ((pn, Just [pv]) :) <$> eachVal ps++ -- | Generate each possible combination of Explicit or non-Explicit -- (Assumed or NotSpecified) parameter value and the corresponding -- string with each combination of separators. The string will be@@ -59,7 +89,7 @@ -> [(String, Maybe String)] -> Logic ([NamedParamMatch], Int, String) pvalMatch seps preset pvals =- let (ppv, rpv) = L.partition isPreset pvals+ let (ppv, _rpv) = L.partition isPreset pvals isPreset p = fst p `elem` (fmap fst preset) matchesPreset = all matchPreset ppv@@ -69,16 +99,6 @@ Just v -> paramMatchVal v pv Nothing -> True - pvVal :: [(String, Maybe String)] -> Logic [NamedParamMatch]- pvVal [] = return []- pvVal ((pn, mpv):ps) =- let explicit v = do nxt <- pvVal ps- return $ (pn, Explicit v) : nxt- notExplicit = let pMatchImpl = maybe NotSpecified Assumed- remPVMS = fmap (fmap pMatchImpl) ps- in return $ (pn, pMatchImpl mpv) : remPVMS- in (maybe mzero explicit mpv) `mplus` notExplicit- genPVStr :: [NamedParamMatch] -> Logic String genPVStr pvs = let vstr = fromMaybe "" . getExplicit . snd@@ -92,10 +112,147 @@ else do s <- eachFrom seps foldM sepJoin [s] pvs - in do guard matchesPreset- candidateVals <- pvVal rpv- let rset = preset <> candidateVals+ in do guard $ matchesPreset+ candidateVals <- pvVals preset pvals+ let rset = preset <> removePVals candidateVals preset orderedRset = fmap from_rset $ fmap fst pvals from_rset n = let v = maybe NotSpecified id $ L.lookup n rset in (n,v) pvstr <- genPVStr orderedRset return (rset, length orderedRset, pvstr)+++-- | Generate the various combinations of parameters+values from the possible+-- set specified by the input.++pvVals :: [NamedParamMatch] -> [(String, Maybe String)] -> Logic [NamedParamMatch]+pvVals _ [] = return []+pvVals presets ((pn, mpv):ps) =+ do nxt <- pvVals presets ps+ let explicit v = return $ (pn, Explicit v) : nxt+ notExplicit = let pMatchImpl =+ case lookup pn presets of+ Nothing -> maybe NotSpecified Assumed+ Just presetV -> const presetV+ in return $ (pn, pMatchImpl mpv) : nxt+ (maybe mzero explicit mpv) `mplus` notExplicit+++-- | Removes the second set of named params from the first set, leaving the+-- remainder of the first set that isn't matched in the second set.++removePVals :: [(String, a)] -> [(String, b)] -> [(String, a)]+removePVals main rmv = filter (not . (`elem` (fst <$> rmv)) . fst) main+++-- | This provides an Ordering result of comparing two sets of NamedParamMatch.+-- This can be used for sorting or other prioritization of named matches.++pmatchCmp :: [ NamedParamMatch ] -> [ NamedParamMatch ] -> Ordering+pmatchCmp p1 p2 =+ let comparisons =+ [+ -- the one with more Explicit matches is better+ compare `on` (length . filter (isExplicit . snd))+ -- the one with more parameters (usually the same)+ , compare `on` length+ -- comparing keys+ , compare `on` (L.sort . fmap fst)+ ]+ -- comparing the correlated ParamMatch values+ <> map (\k -> compare `on` (lookup k)) (fst <$> p1)+ in cascadeCompare comparisons p1 p2++cascadeCompare :: [ a -> a -> Ordering ] -> a -> a -> Ordering+cascadeCompare [] _ _ = EQ+cascadeCompare (o:os) a b = case o a b of+ EQ -> cascadeCompare os a b+ x -> x++-- | Returns the maximum of two arguments based on comparing the+-- [NamedParamMatch] extracted from each argument (via the passed function).++pmatchMax :: (a -> [NamedParamMatch]) -> a -> a -> a+pmatchMax f a b = case pmatchCmp (f a) (f b) of+ LT -> b+ _ -> a+++-- | Given the root directory and a file in that directory, along with the+-- possible parameters and values, return each valid set of parameter matches+-- from that file, along with the remaining unmatched parameter possibilities.+--+-- The first set of parameters is the total set, and the second set represents+-- those that could be identified in the path subdirs; this is needed to prevent+-- a wildcard ParameterPattern in the second set from matching values explicit to+-- other parameters.++dirMatches :: CandidateFile -> [ParameterPattern] -> [ParameterPattern]+ -> Logic ([NamedParamMatch], [ParameterPattern])+dirMatches fname fullParams params = do+ let pathPart = candidateSubdirs fname++ let findVMatch :: FilePath -> (String, Maybe [String]) -> Maybe String+ findVMatch e (pn,pv) =+ case pv of+ Nothing -> Nothing+ Just vs -> if e `elem` vs then Just pn else Nothing+ let findPVMatch parms pthPartE found =+ listToMaybe (catMaybes (map (findVMatch pthPartE) parms)) : found++ let pmatches = foldr (findPVMatch params) [] pathPart++ let freeParam = fst <$> L.find (isNothing . snd) params++ let freeParts =+ let allpvals = concat $ catMaybes (snd <$> fullParams)+ in (not . (`elem` allpvals)) <$> pathPart++ dmatch <- fmap (fmap Explicit)+ . fmap (first fromJust)+ . filter (not . isNothing . fst)+ <$> ((return (zip pmatches pathPart))+ `mplus`+ (inEachNothing freeParam $ zip3 pmatches freeParts pathPart))++ let drem = removePVals params dmatch++ return (dmatch, drem)+++-- | Return each substitution of the first argument for each location in the+-- second list that has a Nothing label and a True parameter; leave non-Nothings+-- in the second list unchanged.++inEachNothing :: Maybe a -> [(Maybe a,Bool,b)] -> Logic [(Maybe a,b)]+inEachNothing mark into = do+ let canSubst (a,b,_) = b && isNothing a+ let spots = filter (\i -> canSubst (into !! i)) $ [0..(length into) - 1]+ i <- eachFrom spots+ let deBool (a,_,c) = (a,c)+ let thrd (_,_,c) = c+ return+ $ (deBool <$> take i into)+ <> [ (mark, thrd (into !! i)) ]+ <> (deBool <$> drop (i + 1) into)+++-- | isCompatible can be used as a filter predicate to determine if the specified+-- file is compatible with the provided parameters and chosen parameter values.+-- One principle compatibility check is ensuring that there is no *other*+-- parameter value in the filename that conflicts with a chosen parameter value.+isCompatible :: Separators+ -> [ParameterPattern]+ -> [(String, Maybe String)]+ -> CandidateFile+ -> Bool+isCompatible seps params pvals fname =+ let splitFName n = let (p,r) = break (`elem` seps) n+ in p : if null r then [] else splitFName (tail r)+ parts = let n' = splitFName $ candidateFile fname+ in candidateSubdirs fname <> n'+ noConflict _ (_,Nothing) = True+ noConflict ps (pn,Just vs) = all (not . isConflict pn vs) ps+ isConflict pn vs p = and [ p `elem` vs+ , maybe False (Just p /=) $ lookup pn pvals+ ]+ in all (noConflict parts) params
src/internal/Test/Tasty/Sugar/Report.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} +-- | Generate user-consumable reports regarding the findings of tasty-sugar.+ module Test.Tasty.Sugar.Report ( sweetsKVITable@@ -20,6 +22,8 @@ import Test.Tasty.Sugar.Types +-- | Converts a set of discovered Sweets into a KVITable; this is usually done in+-- order to render the KVITable in a readable format. sweetsKVITable :: [Sweets] -> KVITable FilePath sweetsKVITable [] = mempty sweetsKVITable sweets =@@ -27,6 +31,7 @@ (\s -> [ ( ("base", T.pack $ rootBaseName s)+ : ("rootFile", T.pack $ rootFile s) : [ (T.pack pn, T.pack $ show $ PP.pretty pv) | (pn,pv) <- expParamsMatch e ] <> [ (T.pack an, T.pack $ takeFileName af)@@ -38,12 +43,16 @@ sweets in t & valueColName .~ "Expected File" +-- | Converts a set of discovered Sweets directly into a text-based table for+-- shoing to the user. sweetsTextTable :: [CUBE] -> [Sweets] -> Text sweetsTextTable [] _ = "No CUBE provided for report" sweetsTextTable _ [] = "No Sweets provided for report" sweetsTextTable c s = let cfg = defaultRenderConfig { rowGroup = "base"+ : "rootFile" : (T.pack . fst <$> take 1 (validParams $ head c))+ , rowRepeat = False } in render cfg $ sweetsKVITable s
src/internal/Test/Tasty/Sugar/RootCheck.hs view
@@ -19,15 +19,18 @@ -- | Determine which parts of the input name form the basePrefix and any--- parameter values for searching for related files (expected and--- associated)-rootMatch :: FilePath -> Separators -> [ParameterPattern] -> String- -> Logic ([NamedParamMatch], FilePath, FilePath)-rootMatch origRootName seps params rootCmp =- ifte- (rootParamMatch origRootName seps params rootCmp)- return- (noRootParamMatch origRootName seps)+-- parameter values for searching for related files (expected and associated).+-- Parameter values are taken from subdirectory paths or filename elements (in+-- that order).+rootMatch :: CandidateFile -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], CandidateFile, String)+rootMatch origRoot seps params rootCmp = do+ (dmatch, drem) <- dirMatches origRoot params params+ (rpm, p, s) <- ifte+ (rootParamMatch origRoot seps drem rootCmp)+ return+ (noRootParamMatch origRoot seps)+ return (dmatch <> rpm, p, s) data RootPart = RootSep String@@ -50,30 +53,32 @@ RootParNm _ x -> x RootText x -> x RootSuffix x -> x- bld a b = a <> s b- in foldl bld ""+ bld b a = a <> s b+ in foldr bld "" rpNPM :: [RootPart] -> [NamedParamMatch] rpNPM = let bld (RootParNm n v) = Just [(n, Explicit v)] bld (RootSep _) = Nothing- bld p = error ("Invalid RootPart for NamedParamMatch: "- <> show p)+ bld p = error ("Invalid RootPart for NamedParamMatch: " <> show p) in concat . catMaybes . fmap bld -- Return the prefix and suffix of the root name along with the -- explicit parameter matches that comprise the central portion.-rootParamMatch :: FilePath -> Separators -> [ParameterPattern] -> String- -> Logic ([NamedParamMatch], FilePath, FilePath)-rootParamMatch origRootName seps params rootCmp =+rootParamMatch :: CandidateFile+ -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], CandidateFile, String)+rootParamMatch origRoot seps params rootCmp = if null seps- then rootParamMatchNoSeps origRootName seps params- else rootParamMatches origRootName seps params rootCmp+ then rootParamMatchNoSeps origRoot seps params+ else rootParamFileMatches origRoot seps params rootCmp -rootParamMatches :: FilePath -> Separators -> [ParameterPattern] -> String- -> Logic ([NamedParamMatch], FilePath, FilePath)-rootParamMatches rootNm seps parms rMatch = do- let rnSplit = sepSplit rootNm++rootParamFileMatches :: CandidateFile+ -> Separators -> [ParameterPattern] -> String+ -> Logic ([NamedParamMatch], CandidateFile, String)+rootParamFileMatches rootF seps parms rMatch = do+ let rnSplit = sepSplit $ candidateFile rootF sepSplit = L.groupBy sepPoint sepPoint a b = not $ or [a `elem` seps, b `elem` seps ] rnPartIndices = [ n | n <- [0 .. length rnParts - 1] , even n ]@@ -82,13 +87,12 @@ txtRootSfx = sepSplit $ reverse $ -- Find the concrete extension in the -- rootName. Somewhat crude, but basically stops at- -- any charcter that could be part of a filemanip+ -- any character that could be part of a filemanip -- GlobPattern. takeWhile (not . flip elem "[*]\\(|)") $ reverse rMatch - -- if a part of the rootNm matches a known parameter value,- -- that is the only way that part can be interpreted, and- -- that anchors it.+ -- if a part of the root filename matches a known parameter value, that is+ -- the only way that part can be interpreted, and that anchors it. rnParts :: [RootPart] rnParts =@@ -103,12 +107,20 @@ Just (pn,_) -> RootParNm pn ptxt Nothing -> RootText ptxt else RootSep ptxt- in fmap assignPart $ zip rnSplit [0..] -- want [prefix, sep, MATCHES, [suffix]] guard (length rnSplit > 2 + length txtRootSfx) + let hasDupParNm =+ let getParNm = \case+ RootParNm pn _ -> Just pn+ _ -> Nothing+ parNms = catMaybes (getParNm <$> rnParts)+ in not $ length parNms == length (L.nub parNms)++ guard (not hasDupParNm)+ guard (not $ isRootParNm $ head rnParts) -- must have a prefix let rnChunks =@@ -149,40 +161,44 @@ , rpStr $ drop (idx + 2) allRP ) _ -> mzero freeFirst (Just (Left (pfx, pl1, sfx))) =- if length pfx < 3- then mzero- else case freeValueParm of- Nothing ->- -- No wildcard param, so just try the observed- -- pattern- return ( rpNPM pl1, rpStr pfx, rpStr sfx )- Just p ->- -- There is a wildcard parameter, try it at the end- -- of pfx and before pl1- case reverse pfx of- (_:RootText lpv:_) ->- return ( rpNPM $ RootParNm (fst p) lpv : pl1- , rpStr $ reverse $ drop 3 $ reverse pfx- , rpStr sfx )- _ -> mzero+ case freeValueParm of+ Nothing ->+ -- No wildcard param, so just try the observed+ -- pattern+ return ( rpNPM pl1, rpStr $ init pfx, rpStr sfx )+ Just p ->+ if length pfx < 3+ then+ -- not enough elements of pfx to support a wildcard, so there must+ -- be no expression of the wildcard and just the observed pattern.+ -- Also remove any separator from the prefix.+ return ( rpNPM pl1, rpStr $ take 1 pfx, rpStr sfx )+ else+ -- There is a wildcard parameter, try it at the end+ -- of pfx and before pl1+ case reverse pfx of+ (_:RootText lpv:_) ->+ return ( rpNPM $ RootParNm (fst p) lpv : pl1+ , rpStr $ reverse $ drop 3 $ reverse pfx+ , rpStr sfx )+ _ -> mzero freeLast Nothing = mzero freeLast (Just (Right _)) = mzero freeLast (Just (Left (_, [], []))) = mzero -- handled by freeFirst+ freeLast (Just (Left (_, _, []))) = mzero freeLast (Just (Left (pfx, parms1, sfx))) =- if null sfx- then mzero- else case freeValueParm of- Nothing -> mzero -- handled by freeFirst- Just p ->- -- There is a wildcard parameter, try it at the end- -- of pfx and before pl1- case sfx of- (RootText fsv:_) ->- return ( rpNPM $ parms1 <> [RootParNm (fst p) fsv]- , rpStr pfx- , rpStr $ tail sfx )- _ -> mzero+ case freeValueParm of+ Nothing -> mzero -- handled by freeFirst+ Just p ->+ -- There is a wildcard parameter, try it at the end+ -- of pfx and before pl1+ case sfx of+ (RootText fsv:_) ->+ return ( rpNPM $ parms1 <> [RootParNm (fst p) fsv]+ , rpStr $ init pfx+ , rpStr $ tail sfx )+ _ -> mzero freeMid Nothing = mzero freeMid (Just (Left _)) = mzero@@ -203,23 +219,25 @@ , rpStr $ ms2 : sfx ) _ -> mzero - (freeFirst rnChunks)- `mplus` (freeLast rnChunks)- `mplus` (freeMid rnChunks)+ (\(a,fn,b) -> (a, rootF { candidateFile = fn }, b))+ <$> ((freeFirst rnChunks)+ `mplus` (freeLast rnChunks)+ `mplus` (freeMid rnChunks)) -- If no separators, there are no "rnParts" identifiable, so fall -- back on a cruder algorithm that simply attempts to find a -- sequence of paramvals in the middle of the string and extract -- the prefix and suffix (if any) around those paramvals.-rootParamMatchNoSeps :: FilePath -> Separators -> [ParameterPattern]- -> Logic ([NamedParamMatch], FilePath, FilePath)-rootParamMatchNoSeps rootNm seps' parms = do+rootParamMatchNoSeps :: CandidateFile -> Separators -> [ParameterPattern]+ -> Logic ([NamedParamMatch], CandidateFile, String)+rootParamMatchNoSeps rootF seps' parms = do pseq <- eachFrom $ filter (not . null) $ L.permutations parms pvals <- getPVals pseq (pvset, _pvcnt, pvstr) <- pvalMatch seps' [] pvals -- _pvcnt can be ignored because each is a different root let explicit = filter (isExplicit . snd) pvset+ let rootNm = candidateFile rootF guard (and [ not $ null explicit , pvstr `L.isInfixOf` rootNm , not $ pvstr `L.isPrefixOf` rootNm@@ -230,19 +248,21 @@ matches n = pvstr `L.isPrefixOf` (drop n rootNm) case L.find matches $ reverse [1..bslen] of Just pfxlen ->- let basename = take pfxlen rootNm+ let basefname = take pfxlen rootNm+ basename = rootF { candidateFile = basefname } suffix = drop (pfxlen + l2) rootNm in return (explicit, basename, suffix) _ -> mzero -- Return origRootName up to each sep-indicated point.-noRootParamMatch :: FilePath -> Separators- -> Logic ([NamedParamMatch], FilePath, FilePath)-noRootParamMatch origRootName seps =- return ([], origRootName, "") `mplus`+noRootParamMatch :: CandidateFile -> Separators+ -> Logic ([NamedParamMatch], CandidateFile, String)+noRootParamMatch origRoot seps =+ return ([], origRoot, "") `mplus` do s <- eachFrom seps+ let origRootName = candidateFile origRoot i <- eachFrom [1..length origRootName - 1]- let a = take i origRootName+ let a = origRoot { candidateFile = take i origRootName } let b = drop i origRootName if null b then do return ([], a, "")
src/internal/Test/Tasty/Sugar/Types.hs view
@@ -10,6 +10,7 @@ import Data.Function ( on ) import qualified Data.List as L import Data.Maybe ( catMaybes )+import System.FilePath -- ( (</>) ) import qualified System.FilePath.GlobPattern as FPGP #if MIN_VERSION_prettyprinter(1,7,0) import Prettyprinter@@ -33,7 +34,7 @@ -- -- The primary elements to specify are the 'rootName' and the -- 'expectedSuffix'. With these two specifications (and possibly the--- 'inputDir') the 'Test.Tasty.Sugar' functionality will be similar to+-- 'inputDirs') the 'Test.Tasty.Sugar' functionality will be similar to -- a "golden" testing package. -- -- The 'validParams' is an optional feature that is useful when@@ -46,24 +47,29 @@ -- data CUBE = CUBE {- -- | The directory in which the sample files that drive the- -- testing exist. When specified as a relative filepath- -- (suggested) then this directory is relative to the cabal file.+ -- | The original directory in which the sample files can be found. This is+ -- provided for backward-compatibility, but the use of the 'inputDirs'+ -- alternative is recommended. inputDir :: FilePath + -- | The directories in which the sample files that drive the+ -- testing exist. When specified as a relative filepath+ -- (suggested) then a directory is relative to the cabal file.+ , inputDirs :: [FilePath]+ -- | The name of the "root" file for each test scenario. The -- contents of this file are opaque to 'tasty-sweet' and are -- interpreted by the tests themselves. Each "root" file is -- the kernel for a set of test cases. -- -- The root file should not be specified with any path element,- -- it should exist in the 'inputDir' location and it can be+ -- it should exist in one of the 'inputDirs' location and it can be -- specified as a glob pattern. -- -- The corresponding expected results files will be identified by -- finding files which match a portion of this name with a -- "{separator}{expectedSuffix}" appended to it.- , rootName :: FPGP.GlobPattern+ , rootName :: FPGP.GlobPattern -- | The expected suffix for a target pattern for running a test. -- There may be multiple files specifying expected results for a@@ -79,7 +85,7 @@ -- considered if preceeded by that specific separator; otherwise -- any of the 'separators' may be used prior to the -- 'expectedSuffix'.- , expectedSuffix :: FileSuffix+ , expectedSuffix :: FileSuffix -- | The 'separators' specify the characters which separate the -- expected suffix from the rootName, and which also separate@@ -94,7 +100,7 @@ -- The default separators (returned by 'mkCUBE') are ".-" meaning -- that extensions (and parameters) can be separated from the -- base name by either a period or a dash.- , separators :: Separators+ , separators :: Separators -- | The 'associatedNames' specifies other files that are -- associated with a particular test configuration. These files@@ -107,7 +113,7 @@ -- Specified as a list of tuples, where each tuple is the -- (arbitrary) name of the associated file type, and the file -- type suffix (with no period or other separator).- , associatedNames :: [ (String, FileSuffix) ]+ , associatedNames :: [ (String, FileSuffix) ] -- | The 'validParams' can be used to specify various parameters -- that may be present in the filename.@@ -126,11 +132,11 @@ -- > foo-clang.x86_64.o -- > foo.O0-clang.o --- -- The sugar matching code will attempt to identify the various- -- parameter values appearing in the _expected_ filename and- -- provide that information to the test generation process to- -- allow the generated test to be customized to the available set- -- of parameters.+ -- The sugar matching code will attempt to identify the various parameter+ -- values appearing in the _EXPECTED_ filename which correspond to the same+ -- values in the _ROOT_ filename and provide that information to the test+ -- generation process to allow the generated test to be customized to the+ -- available set of parameters. -- -- The 'associatedNames' provided to the test generator will be -- constrained to those associated names that match the parameter@@ -150,10 +156,11 @@ -- must be explicit and precise matches) and they cannot be blank -- (the lack of a parameter is handled automatically rather than -- an explicit blank value).- , validParams :: [ParameterPattern]+ , validParams :: [ParameterPattern] } deriving (Show, Read) +{-# DEPRECATED inputDir "Use inputDirs instead" #-} -- | Parameters are specified by their name and a possible list of -- valid values. If there is no list of valid values, any value is@@ -162,6 +169,8 @@ type ParameterPattern = (String, Maybe [String]) + -- KWQ: if this could be an exact string or a regexp (or a glob?) then that would remove the need for a complete enumeration but not be a full wildcard. For example: llvm* to capture different llvm versions available. However, this is super-hard, because many elements use Logic to generate all potential parameter value combinations, so this would need to be inverted, and still wouldn't handle Assumed values well.+ -- | Separators for the path and suffix specifications. Any separator -- is accepted in any position between parameters and prior to the -- expected suffix. The synonym name is primarily used to indicate@@ -170,10 +179,18 @@ type Separators = String -- | Generates the default 'CUBE' configuration; callers should override--- individual fields as appropriate.+-- individual fields as appropriate. This is the preferred way to initialize a+-- CUBE if defaults are to be used for various fields:+--+-- * inputDirs: [ "test/samples" ]+-- * inputDir: "test/samples"+-- * separators: .-+-- * rootName: *+-- * expectedSuffix: exp mkCUBE :: CUBE-mkCUBE = CUBE { inputDir = "test/samples"+mkCUBE = CUBE { inputDirs = ["test/samples"]+ , inputDir = "" , separators = ".-" , rootName = "*" , associatedNames = []@@ -186,7 +203,8 @@ pretty cube = let assoc = prettyAssocNames $ associatedNames cube parms = prettyParamPatterns $ validParams cube- hdrs = [ "input dir: " <+> pretty (inputDir cube)+ hdrs = [ "input dirs: "+ <+> pretty (L.nub $ inputDir cube : inputDirs cube) , "rootName: " <+> pretty (rootName cube) , "expected: " <+> brackets (pretty $ separators cube) <>@@ -215,13 +233,41 @@ map pretty vl in indent 1 $ vsep $ map pp prms) +-- | Internally, this keeps the association between a possible file and the input+-- directory it came from. The "file" portion is relative to the input+-- directory.++data CandidateFile = CandidateFile { candidateDir :: FilePath+ , candidateSubdirs :: [ FilePath ]+ , candidateFile :: FilePath+ }+ deriving (Eq, Show) -- Show is for for debugging/tracing++-- | This converts a CandidatFile into a regular FilePath for access+candidateToPath :: CandidateFile -> FilePath+candidateToPath c =+ candidateDir c </> foldr (</>) (candidateFile c) (candidateSubdirs c)++ -- | Each identified test input set is represented as a 'Sweets' -- object.. a Specifications With Existing Expected Testing Samples. data Sweets = Sweets- { rootBaseName :: String -- ^ base of root for matching to expected- , rootMatchName :: String -- ^ full name of matched root- , rootFile :: FilePath -- ^ full filepath of matched root+ { rootBaseName :: String+ -- ^ The base of the root path for matching to expected. This has no path+ -- elements, no extensions and no parameters. It can be useful to use to+ -- compare to other fields in the 'expected' Expectation list of this+ -- structure. Note that if the root file matched had parameters as part of+ -- the filename, those are not present in this rootBaseName.+ , rootMatchName :: String+ -- ^ Matched root. This is the name of the matched file, (no path elements)+ -- that matched the rootName in the input CUBE. This includes any extension+ -- or parameter substitutions. This is often the best name to use for+ -- displaying this matched item.+ , rootFile :: FilePath+ -- ^ The full actual filepath of the matched root, with all path elements,+ -- extensions, parameters, and suffixes present. This is most useful to open+ -- or otherwise access the file. , cubeParams :: [ParameterPattern] -- ^ parameters for match , expected :: [Expectation] -- ^ all expected files and associated }@@ -322,7 +368,7 @@ -- 'NotSpecified' for this type of parameter. | NotSpecified - deriving (Show, Eq)+ deriving (Show, Eq, Ord) instance Pretty ParamMatch where pretty (Explicit s) = pretty s@@ -350,6 +396,13 @@ getExplicit (Explicit v) = Just v getExplicit _ = Nothing +-- | If there is a value associated with this parameter, return the value,+-- regardless of whether it is Explicit or Assumed. A wildcard is a Nothing+-- return.+getParamVal :: ParamMatch -> Maybe String+getParamVal (Explicit v) = Just v+getParamVal (Assumed v) = Just v+getParamVal _ = Nothing ---------------------------------------------------------------------- @@ -360,7 +413,7 @@ SweetExpl { rootPath :: FilePath , base :: String , expectedNames :: [String] -- ^ candidates- , results :: [Sweets] -- ^ actual results+ , results :: Sweets -- ^ actual results } instance Pretty SweetExplanation where@@ -377,10 +430,7 @@ , if null nms then Nothing else Just $ indent 8 $ vsep $ map pretty nms- , if null (results expl)- then Nothing- else Just $ indent 2 $ hang 2 $ vsep $- "Results:" : map pretty (results expl)+ , Just $ pretty $ results expl ] ------------------------------------------------------------------------
tasty-sugar.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: tasty-sugar-version: 1.2.0.0+version: 1.3.0.0 synopsis: Tests defined by Search Using Golden Answer References description: .@@ -25,7 +25,7 @@ category: Testing build-type: Simple -tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.1 GHC ==9.0.1+tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.1 GHC ==9.2.3 extra-source-files: CHANGELOG.md README.org@@ -110,6 +110,7 @@ main-is: TestMain.hs other-modules: TestMultiAssoc TestNoAssoc+ TestFileSys TestGCD TestSingleAssoc TestStrlen2
test/Sample1.hs view
@@ -2,10 +2,21 @@ module Sample1 where -import Text.RawString.QQ+import System.FilePath ( (</>) ) -sample1 :: [String]-sample1 = lines [r|+import Test.Tasty.Sugar++import Text.RawString.QQ+++sample1 :: FilePath -> [CandidateFile]+sample1 testInpPath =+ fmap (\f -> CandidateFile { candidateDir = testInpPath+ , candidateSubdirs = []+ , candidateFile = f })++ $ filter (not . null)+ $ lines [r| global-max-good.c global-max-good.ppc.o global-max-good.ppc.exe
+ test/TestFileSys.hs view
@@ -0,0 +1,1141 @@+module TestFileSys ( fileSysTests ) where++import qualified Data.List as L+import qualified Data.Text as T+import System.FilePath ( (</>), takeDirectory )+import qualified Test.Tasty as TT+import Test.Tasty.HUnit+import Test.Tasty.Sugar+import TestUtils+import Text.RawString.QQ+import Text.Show.Pretty+++testInpPath = "test/data/single"+testInpPath2 = "test/data/second"+testInpPath3 = "test/builds/*"++testParams = [ ("llvm", Just [ "llvm9", "llvm10", "llvm13" ])+ , ("debug", Just [ "yes", "no" ])+ , ("opt", Nothing )+ ]++sugarCube1 = mkCUBE+ { inputDirs = [ testInpPath ]+ , rootName = "*.exe"+ , validParams = testParams+ , associatedNames = [ ("config", "config")+ , ("ld-config", "lnk")+ , ("source", "c")+ ]+ }++sugarCube2 = mkCUBE+ { inputDirs = [ testInpPath, "foo/baz", testInpPath2, "/foo/bar" ]+ , rootName = "*.exe"+ , validParams = testParams+ , associatedNames = [ ("config", "config")+ , ("ld-config", "lnk")+ , ("source", "c")+ ]+ }++sugarCube3 = mkCUBE+ { inputDirs = [ testInpPath+ , "foo/baz"+ , testInpPath2+ , testInpPath3+ ]+ , rootName = "*.exe"+ , validParams = testParams+ , associatedNames = [ ("config", "config")+ , ("ld-config", "lnk")+ , ("source", "c")+ ]+ }+++fileSysTests :: IO [TT.TestTree]+fileSysTests = do tsts <- sequence [ fsTests1, fsTests2, fsTests3 ]+ return [ TT.testGroup "FileSys" $ concat tsts ]+++fsTests1 :: IO [TT.TestTree]+fsTests1 = do+ sweets <- findSugar sugarCube1+ -- putStrLn $ ppShow sweets+ return+ [ TT.testGroup "Cube 1"+ [ testCase "correct # of sweets" $ 3 @=? length sweets++ , TT.testGroup "Sweet #1" $+ let sweet = head sweets in+ [+ testCase "root match" $ "foo.llvm10.O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm10.O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testCase "Exp #1" $ head (expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ , TT.testGroup "Sweet #2" $+ let sweet = head $ drop 1 sweets in+ [+ testCase "root match" $ "foo.llvm13.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm13.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ , TT.testGroup "Sweet #3" $+ let sweet = head $ drop 2 sweets in+ [+ testCase "root match" $ "foo.llvm9.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm9.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ ]+ ]+++fsTests2 :: IO [TT.TestTree]+fsTests2 = do+ sweets <- findSugar sugarCube2+ -- putStrLn $ ppShow sweets+ return+ [ TT.testGroup "Cube 2"+ [ testCase "correct # of sweets" $ 5 @=? length sweets+ , TT.testGroup "Sweet #1" $+ let sweet = head sweets in+ [+ testCase "root match" $ "cow-O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "cow-O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm13")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #5" $ head (drop 4 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm13")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #6" $ head (drop 5 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ ]+ , TT.testGroup "Sweet #2" $+ let sweet = head $ drop 1 sweets in+ [+ testCase "root match" $ "foo.O1-llvm10.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "foo.O1-llvm10.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ , TT.testGroup "Sweet #3" $+ let sweet = head $ drop 2 sweets in+ [+ testCase "root match" $ "foo.llvm10.O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm10.O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testCase "Exp #1" $ head (expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ , TT.testGroup "Sweet #4" $+ let sweet = head $ drop 3 sweets in+ [+ testCase "root match" $ "foo.llvm13.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm13.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath2 </> "foo-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath2 </> "foo-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ , TT.testGroup "Sweet #5" $+ let sweet = head $ drop 4 sweets in+ [+ testCase "root match" $ "foo.llvm9.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm9.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]+ ]+ ]++fsTests3 :: IO [TT.TestTree]+fsTests3 = do+ sweets <- findSugar sugarCube3+ -- putStrLn $ ppShow sweets+ return+ [ TT.testGroup "Cube 3"+ [ testCase "correct # of sweets" $ 12 @=? length sweets+ , let sweetNum = 8+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "cow-O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "cow-O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm13")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #5" $ head (drop 4 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm13")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #6" $ head (drop 5 $ expected sweet) @?=+ Expectation+ {+ expectedFile = testInpPath </> "cow.O2.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O2")+ ]+ -- n.b. O0/llvm9/cow.lnk matches because opt is a wildcard, so no+ -- way to know that O0 in cow.lnk is conflicing with O2 in+ -- cow.O2.exp.+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ ]+++ , let sweetNum = 6+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "cow.exe" @=? rootMatchName sweet+ , testCase "root file"+ $ takeDirectory testInpPath3 </> "llvm13/cow.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ ]++ , let sweetNum = 7+ sweet = head $ drop (sweetNum - 1) sweets+ exp n = head $ drop (n-1) $ expected sweet+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "cow.exe" @=? rootMatchName sweet+ , testCase "root file"+ $ takeDirectory testInpPath3 </> "llvm13/opts/O3/cow.exe" @=? rootFile sweet+ , testCase "# expectations" $ 8 @=? length (expected sweet)+ , testCase "Exp #1" $ exp 1 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #2" $ exp 2 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ -- Note: the expectations match an exp with O0 in the name, which+ -- would seem to conflict with O3, but since "opt" is a wildcard+ -- parameter there's no way for tasty-sweet to know that O3 and O0+ -- conflict, and the match on the llvm13 value makes that .exp more+ -- attractive than the generic one.+ , testCase "Exp #3" $ exp 3 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #4" $ exp 4 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O3")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #5" $ exp 5 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "opts")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #6" $ exp 6 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #7" $ exp 7 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O3")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #8" $ exp 8 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "opts")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ ]++ , let sweetNum = 1+ sweet = head $ drop (sweetNum - 1) sweets+ exp n = head $ drop (n-1) $ expected sweet+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ -- n.b. Although O0 appears in the root file and in the O0/cow.exp+ -- expected files in Exp 3 and Exp 4 below, O0 is a wildcard, so it's+ -- also possible to match NotSpecified for the "opt" parameter, and in+ -- that case, the base cow.exp from Exp 1 and Exp 2 are found.+ -- Eliminating these would involve matching the O0 portions of the+ -- filepath even though it is not associated with any parameter; that+ -- becomes even more complex and the results will be less+ -- consistent/explainable than the current situation, thus the current+ -- functionality.+ [+ testCase "root match" $ "cow.exe" @=? rootMatchName sweet+ , testCase "root file"+ $ takeDirectory testInpPath3 </> "O0/cow.exe" @=? rootFile sweet+ , testCase "# expectations" $ 12 @=? length (expected sweet)+ , testCase "Exp #1" $ exp 1 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #2" $ exp 2 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #3" $ exp 3 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #4" $ exp 4 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #5" $ exp 5 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c")+ ]+ }+++ , testCase "Exp #6" $ exp 6 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #7" $ exp 7 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #8" $ exp 8 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #9" $ exp 9 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm10")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #10" $ exp 10 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Assumed "llvm9")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c")+ ]+ }+ , testCase "Exp #11" $ exp 11 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #12" $ exp 12 @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("source", testInpPath </> "cow.c") ]+ }+ ]++ , let sweetNum = 2+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "cow.exe" @=? rootMatchName sweet+ , testCase "root file" $ takeDirectory testInpPath3 </> "O0/llvm9/cow.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ -- n.b. See note for Sweet #1+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "O0" </> "cow.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "O0")+ ]+ , associated = [ ("ld-config", takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ , ("source", testInpPath </> "cow.c") ]+ }+ ]++ , let sweetNum = 9+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "foo.O1-llvm10.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "foo.O1-llvm10.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "llvm10" </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "llvm10" </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]++ , let sweetNum = 10+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "foo.llvm10.O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm10.O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "llvm10" </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ {+ expectedFile = takeDirectory testInpPath3 </> "llvm10" </> "foo.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm10-O2-exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "O2")+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]++ , let sweetNum = 11+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "foo.llvm13.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm13.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath2 </> "foo-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath2 </> "foo-llvm13.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]++ , let sweetNum = 12+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "foo.llvm9.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm9.exe" @=? rootFile sweet+ , testCase "# expectations" $ 2 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = testInpPath </> "foo.llvm9.exp"+ , expParamsMatch = [ ("debug", Assumed "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ ]++ , let sweetNum = 5+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "frog.exe" @=? rootMatchName sweet+ , testCase "root file" $ takeDirectory testInpPath3 </> "gen/llvm9/frog.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-llvm9-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-llvm9-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-llvm9-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ , testCase "Exp #5" $ head (drop 4 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #6" $ head (drop 5 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm9")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ ]++ , let sweetNum = 3+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "frog.exe" @=? rootMatchName sweet+ , testCase "root file" $ takeDirectory testInpPath3 </> "gen/llvm10/frog.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ , testCase "Exp #5" $ head (drop 4 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #6" $ head (drop 5 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm10")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ ]++ , let sweetNum = 4+ sweet = head $ drop (sweetNum - 1) sweets+ in TT.testGroup ("Sweet #" <> show sweetNum) $+ [+ testCase "root match" $ "frog.exe" @=? rootMatchName sweet+ , testCase "root file" $ takeDirectory testInpPath3 </> "gen/llvm13/frog.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testCase "Exp #1" $ head (drop 0 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #2" $ head (drop 1 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", NotSpecified)+ ]+ , associated = [ ]+ }+ , testCase "Exp #3" $ head (drop 2 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #4" $ head (drop 3 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-no.exp"+ , expParamsMatch = [ ("debug", Explicit "no")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ , testCase "Exp #5" $ head (drop 4 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "gen")+ ]+ , associated = [ ]+ }+ , testCase "Exp #6" $ head (drop 5 $ expected sweet) @?=+ Expectation+ { expectedFile = takeDirectory testInpPath3 </> "want/frog-yes.exp"+ , expParamsMatch = [ ("debug", Explicit "yes")+ , ("llvm", Explicit "llvm13")+ , ("opt", Explicit "want")+ ]+ , associated = [ ]+ }+ ]++ , testCase "correct # of foo sweets" $ 4 @=?+ length (filter (("foo" `L.isPrefixOf`) . rootMatchName) sweets)+ , testCase "correct # of cow sweets" $ 5 @=?+ length (filter (("cow" `L.isPrefixOf`) . rootMatchName) sweets)+ , testCase "correct # of frog sweets" $ 3 @=?+ length (filter (("frog" `L.isPrefixOf`) . rootMatchName) sweets)+ , testCase "foo sweet roots"+ $ [ "test/data/second/foo.O1-llvm10.exe"+ , "test/data/single/foo.llvm10.O2.exe"+ , "test/data/single/foo.llvm13.exe"+ , "test/data/single/foo.llvm9.exe"] @=?+ rootFile <$> (filter (("foo" `L.isPrefixOf`) . rootMatchName) sweets)+ , testCase "cow sweet roots"+ $ [ "test/builds/O0/cow.exe"+ , "test/builds/O0/llvm9/cow.exe"+ , "test/builds/llvm13/cow.exe"+ , "test/builds/llvm13/opts/O3/cow.exe"+ , "test/data/second/cow-O2.exe"+ ] @=?+ rootFile <$> (filter (("cow" `L.isPrefixOf`) . rootMatchName) sweets)+ , testCase "frog sweet roots"+ $ [ "test/builds/gen/llvm10/frog.exe"+ , "test/builds/gen/llvm13/frog.exe"+ , "test/builds/gen/llvm9/frog.exe"] @=?+ rootFile <$> (filter (("frog" `L.isPrefixOf`) . rootMatchName ) sweets)+ ]+ ]
test/TestGCD.hs view
@@ -21,7 +21,7 @@ sugarCube = mkCUBE { rootName = "*.c" , expectedSuffix = "good"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("config", "config") , ("stdio", "print") , ("haskell", "hs")@@ -32,7 +32,7 @@ gcdSampleTests :: [TT.TestTree] gcdSampleTests = let (sugar,sdesc) = findSugarIn sugarCube gcdSamples- in [ testCase "valid sample" $ 20 @=? length gcdSamples+ in [ testCase "valid sample" $ 19 @=? length gcdSamples , sugarTestEq "correct found count" sugarCube gcdSamples 1 length , testCase "sweets rendering" $@@ -132,7 +132,11 @@ ] ] -gcdSamples = lines [r|+gcdSamples = fmap (\f -> CandidateFile { candidateDir = testInpPath+ , candidateSubdirs = []+ , candidateFile = f })+ $ filter (not . null)+ $ lines [r| gcd-test.boolector.boolector.out gcd-test.boolector.boolector.print.out gcd-test.boolector.good
test/TestMain.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where@@ -25,6 +26,7 @@ import TestStrlen2 import TestUtils import TestWildcard+import TestFileSys main :: IO ()@@ -33,9 +35,15 @@ return $ testGroup (groupName <> " generated") tests in do generatedTests <- namedGenGroup "no association" <$> mkNoAssocTests+ fsTests <- fileSysTests defaultMain $ testGroup "tasty-sweet tests" $- [ testProperty "empty file list" $+ [+#if MIN_VERSION_tasty_hedgehog(1,2,0)+ testPropertyNamed "empty file list" "emptyfile" $+#else+ testProperty "empty file list" $+#endif HH.withTests 10000 $ HH.property $ do cube <- HH.forAll $ genCube HH.assert $ null $ fst $ findSugarIn cube []@@ -44,44 +52,66 @@ [ testCase "duplicate separators" $ (Left "Duplicate separator characters" @=?) =<<- runTestOrErr (CUBE "." "*.foo" "e" ".-." [] [])+ runTestOrErr (mkCUBE { inputDirs = [ "." ]+ , rootName = "*.foo"+ , expectedSuffix = "e"+ , separators = ".-."+ , associatedNames = []+ , validParams = []+ }) , testCase "many duplicate separators" $ (Left "Duplicate separator characters" @=?) =<<- runTestOrErr (CUBE "." "*.foo" "e" ".---....---" [] [])+ runTestOrErr (mkCUBE { inputDirs = [ "." ]+ , rootName = "*.foo"+ , expectedSuffix = "e"+ , separators = ".---....---"+ , associatedNames = []+ , validParams = []+ }) ] , testGroup "invalid parameters" $- let c1 = CUBE "." "*.foo" "e" "." [] [("a", Nothing)- ,("b", Nothing)- ]+ let c1 = mkCUBE { inputDirs = [ "." ]+ , rootName = "*.foo"+ , expectedSuffix = "e"+ , separators = "."+ , associatedNames = []+ , validParams = [("a", Nothing)+ ,("b", Nothing)+ ]+ } msg1 = "Only one parameter can have unconstrained values (i.e. Nothing)"- c2 = CUBE "." "*.foo" "e" "." [] [("a", Just [])]+ c2 = c1 { validParams = [("a", Just [])] } msg2 = "Blank validParams values are not allowed (a)"- c3 = CUBE "." "*.foo" "e" "." [] [("a", Just ["hi", ""])- ,("b", Just ["one", "two"])- ,("c", Just [""])]+ c3 = c1 { validParams = [("a", Just ["hi", ""])+ ,("b", Just ["one", "two"])+ ,("c", Just [""])]+ } msg3 = "Parameter values cannot be blank (a, c)" - c4 = CUBE "." "*.foo" "e" "." [] [("a", Just ["hi", "two"])- ,("b", Just ["one", "two"])- ,("c", Just ["end"])]+ c4 = c1 { validParams = [("a", Just ["hi", "two"])+ ,("b", Just ["one", "two"])+ ,("c", Just ["end"])]+ } msg4 = "Parameter values cannot be duplicated " <> show [(("a","b"), "two")] - c5 = CUBE "." "*.foo" "e" "." [] [("a", Just ["two", "two"])- ,("b", Just ["one", "hi"])- ,("c", Just ["one"])]+ c5 = c1 { validParams = [("a", Just ["two", "two"])+ ,("b", Just ["one", "hi"])+ ,("c", Just ["one"])]+ } msg5 = "Parameter values cannot be duplicated " <> show [ (("a","a"), "two") , (("b", "c"), "one") ] - c6 = CUBE "." "*.foo" "e" ".-o" [] [("a", Just ["two", "t"])- ,("b", Just [".1", "one"- , "hi.u"])- ,("c", Just ["o"])]+ c6 = c1 { separators = ".-o"+ , validParams = [("a", Just ["two", "t"])+ ,("b", Just [".1", "one", "hi.u"])+ ,("c", Just ["o"])]+ } msg6 = "Parameter values cannot contain separators " <> show ["a", "b", "b", "b", "c"] in [@@ -113,7 +143,9 @@ , testGroup "wildcard tests" $ wildcardAssocTests , testGroup "gcd sample tests" $ gcdSampleTests , testGroup "strlen2 sample tests" $ strlen2SampleTests- ] <> generatedTests+ ]+ <> generatedTests+ <> fsTests runTestOrErr :: CUBE -> IO (Either String String)
test/TestMultiAssoc.hs view
@@ -20,7 +20,7 @@ sugarCube = mkCUBE { rootName = "*.c" , expectedSuffix = "expected"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("exe", "exe") , ("obj", "o") , ("include", "h")@@ -35,21 +35,24 @@ multiAssocTests :: [TT.TestTree] multiAssocTests =- let (sugar1,_s1desc) = findSugarIn sugarCube sample1+ let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 testInpPath) in [ -- This is simply the number of entries in sample1; if this -- fails in means that sample1 has been changed and the other -- tests here are likely to need updating.- testCase "valid sample" $ 58 @=? length sample1+ testCase "valid sample" $ 57 @=? length (sample1 testInpPath) - , testCase "sweets rendering" $- let actual = sweetsTextTable [sugarCube] sugar1- in do putStrLn "Table" -- try to start table on its own line- putStrLn $ T.unpack actual- T.length actual > 0 @? "change this to see the table"+ -- KWQ: disabled 28 June 2022: encounters a pathological case in kvitable+ -- rendering that causes this test to run ... forever (?) - , sugarTestEq "correct found count" sugarCube sample1 6 length+ -- , testCase "sweets rendering" $+ -- let actual = sweetsTextTable [sugarCube] sugar1+ -- in do putStrLn "Table" -- try to start table on its own line+ -- putStrLn $ T.unpack actual+ -- T.length actual > 0 @? "change this to see the table" + , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length+ , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in [@@ -60,20 +63,6 @@ , expected = [ Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),- ("form", Assumed "base")]- , associated = [ ("exe", p "global-max-good.x86.exe")- ]- }- , Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),- ("form", Assumed "refined")]- , associated = [ ("exe", p "global-max-good.x86.exe")- ]- }- , Expectation { expectedFile = p "global-max-good.ppc.expected" , expParamsMatch = [("arch", Explicit "ppc"), ("form", Assumed "base")]@@ -89,6 +78,20 @@ , ("obj", p "global-max-good.ppc.o") ] }+ , Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "base")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"),+ ("form", Assumed "refined")]+ , associated = [ ("exe", p "global-max-good.x86.exe")+ ]+ } ] } @@ -98,22 +101,6 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "jumpfar.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "base") ]- , associated = [ ("exe", p "jumpfar.x86.exe")- , ("include", p "jumpfar.h")- ]- }- , Expectation- { expectedFile = p "jumpfar.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined")]- , associated = [ ("exe", p "jumpfar.x86.exe")- , ("include", p "jumpfar.h")- ]- }- , Expectation { expectedFile = p "jumpfar.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ]@@ -133,28 +120,30 @@ , ("obj", p "jumpfar.ppc.o") ] }- ]- }- , Sweets { rootMatchName = "looping.c"- , rootBaseName = "looping"- , rootFile = p "looping.c"- , cubeParams = validParams sugarCube- , expected =- [ Expectation- { expectedFile = p "looping.x86.expected"+ , Expectation+ { expectedFile = p "jumpfar.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "base") ]- , associated = [ ("exe", p "looping.x86.exe")+ , associated = [ ("exe", p "jumpfar.x86.exe")+ , ("include", p "jumpfar.h") ] } , Expectation- { expectedFile = p "looping.x86.expected"+ { expectedFile = p "jumpfar.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "refined")]- , associated = [ ("exe", p "looping.x86.exe")+ , associated = [ ("exe", p "jumpfar.x86.exe")+ , ("include", p "jumpfar.h") ] }- , Expectation+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation { expectedFile = p "looping.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ]@@ -168,6 +157,20 @@ , associated = [ ("exe", p "looping.ppc.exe") ] }+ , Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "looping.x86.exe")+ ]+ } ] } , Sweets { rootMatchName = "looping-around.c"@@ -176,20 +179,6 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "looping-around.expected"- , expParamsMatch = [ ("arch", Assumed "x86")- , ("form", Assumed "base") ]- , associated = [ ("exe", p "looping-around.x86.exe")- ]- }- , Expectation- { expectedFile = p "looping-around.expected"- , expParamsMatch = [ ("arch", Assumed "x86")- , ("form", Assumed "refined")]- , associated = [ ("exe", p "looping-around.x86.exe")- ]- }- , Expectation { expectedFile = p "looping-around.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ]@@ -203,6 +192,20 @@ , associated = [ ("exe", p "looping-around.ppc.exe") ] }+ , Expectation+ { expectedFile = p "looping-around.expected"+ , expParamsMatch = [ ("arch", Assumed "x86")+ , ("form", Assumed "base") ]+ , associated = [ ("exe", p "looping-around.x86.exe")+ ]+ }+ , Expectation+ { expectedFile = p "looping-around.expected"+ , expParamsMatch = [ ("arch", Assumed "x86")+ , ("form", Assumed "refined")]+ , associated = [ ("exe", p "looping-around.x86.exe")+ ]+ } ] } , Sweets { rootMatchName = "switching.c"@@ -211,17 +214,6 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "switching.x86.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "x86")- ]- , associated = [ ("exe", p "switching.x86.exe")- , ("include", p "switching.h")- , ("c++-include", p "switching.hh")- , ("plain", p "switching")- ]- }- , Expectation { expectedFile = p "switching.ppc.base-expected" , expParamsMatch = [ ("form", Explicit "base") , ("arch", Explicit "ppc")@@ -239,6 +231,17 @@ ] } , Expectation+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("form", Explicit "base")+ , ("arch", Explicit "x86")+ ]+ , associated = [ ("exe", p "switching.x86.exe")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]+ }+ , Expectation { expectedFile = p "switching.x86.refined-expected" , expParamsMatch = [ ("form", Explicit "refined") , ("arch", Explicit "x86")@@ -258,31 +261,31 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"), ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")+ , associated = [ ("exe", p "tailrecurse.ppc.exe") ] } , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc") , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")+ , associated = [ ("exe", p "tailrecurse.ppc.exe") ] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"), ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")+ , associated = [ ("exe", p "tailrecurse.x86.exe") ] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")+ , associated = [ ("exe", p "tailrecurse.x86.exe") ] } ]
test/TestNoAssoc.hs view
@@ -17,7 +17,7 @@ sugarCube = mkCUBE { rootName = "*.c" , expectedSuffix = "expected"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [] , validParams = [ ("arch", Just ["x86", "ppc"]) , ("form", Just ["base", "refined"])@@ -26,15 +26,15 @@ noAssocTests :: [TT.TestTree] noAssocTests =- let (sugar1,s1desc) = findSugarIn sugarCube sample1+ let (sugar1,s1desc) = findSugarIn sugarCube (sample1 testInpPath) in [ -- This is simply the number of entries in sample1; if this -- fails in means that sample1 has been changed and the other -- tests here are likely to need updating.- testCase "valid sample" $ 58 @=? length sample1+ testCase "valid sample" $ 57 @=? length (sample1 testInpPath) - , sugarTestEq "correct found count" sugarCube sample1 6 length+ , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in@@ -46,26 +46,26 @@ , expected = [ Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"), ("form", Assumed "base")] , associated = [] } , Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"), ("form", Assumed "refined")] , associated = [] } , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"), ("form", Assumed "base")] , associated = [] } , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"), ("form", Assumed "refined")] , associated = [] }@@ -78,6 +78,18 @@ , cubeParams = validParams sugarCube , expected = [ Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = []+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = []+ }+ , Expectation { expectedFile = p "jumpfar.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "base") ]@@ -89,26 +101,26 @@ , ("form", Assumed "refined")] , associated = [] }- , Expectation- { expectedFile = p "jumpfar.ppc.expected"+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ] , associated = [] } , Expectation- { expectedFile = p "jumpfar.ppc.expected"+ { expectedFile = p "looping.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "refined") ] , associated = [] }- ]- }- , Sweets { rootMatchName = "looping.c"- , rootBaseName = "looping"- , rootFile = p "looping.c"- , cubeParams = validParams sugarCube- , expected =- [ Expectation+ , Expectation { expectedFile = p "looping.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "base") ]@@ -120,26 +132,26 @@ , ("form", Assumed "refined")] , associated = [] }- , Expectation- { expectedFile = p "looping.ppc.expected"+ ]+ }+ , Sweets { rootMatchName = "looping-around.c"+ , rootBaseName = "looping-around"+ , rootFile = p "looping-around.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping-around.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ] , associated = [] } , Expectation- { expectedFile = p "looping.ppc.expected"+ { expectedFile = p "looping-around.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "refined") ] , associated = [] }- ]- }- , Sweets { rootMatchName = "looping-around.c"- , rootBaseName = "looping-around"- , rootFile = p "looping-around.c"- , cubeParams = validParams sugarCube- , expected =- [ Expectation+ , Expectation { expectedFile = p "looping-around.expected" , expParamsMatch = [ ("arch", Assumed "x86") , ("form", Assumed "base") ]@@ -151,18 +163,6 @@ , ("form", Assumed "refined")] , associated = [] }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "base") ]- , associated = []- }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , associated = []- } ] } , Sweets { rootMatchName = "switching.c"@@ -171,23 +171,23 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "switching.x86.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "x86")+ { expectedFile = p "switching.ppc.base-expected"+ , expParamsMatch = [ ("arch", Explicit "ppc")+ , ("form", Explicit "base") ] , associated = [] } , Expectation- { expectedFile = p "switching.ppc.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "ppc")+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Explicit "base") ] , associated = [] } , Expectation { expectedFile = p "switching.x86.refined-expected"- , expParamsMatch = [ ("form", Explicit "refined")- , ("arch", Explicit "x86")+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ] , associated = [] }@@ -199,26 +199,26 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"), ("form", Assumed "base") ] , associated = [] } , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc") , ("form", Assumed "refined") ] , associated = [] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"), ("form", Assumed "base") ] , associated = [] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "refined") ] , associated = [] }@@ -230,7 +230,7 @@ mkNoAssocTests :: IO [TT.TestTree] mkNoAssocTests =- let (sugar1,s1desc) = findSugarIn sugarCube sample1+ let (sugar1,s1desc) = findSugarIn sugarCube $ sample1 testInpPath in do tt <- withSugarGroups sugar1 TT.testGroup $ \sw idx exp -> -- Verify this will suppress the "refined" tests for
test/TestParamsAssoc.hs view
@@ -12,8 +12,12 @@ import Text.RawString.QQ -sample :: [String]-sample = lines [r|+sample :: [CandidateFile]+sample = fmap (\f -> CandidateFile { candidateDir = testInpPath+ , candidateSubdirs = []+ , candidateFile = f })+ $ filter (not . null)+ $ lines [r| recursive.rs recursive.fast.exe recursive.fast.expct@@ -38,7 +42,7 @@ -- identified and removed from the root to match corresponding expects -- and associated files. -sugarCube = mkCUBE { inputDir = testInpPath+sugarCube = mkCUBE { inputDirs = [ testInpPath ] , rootName = "*.exe" , separators = "-." , expectedSuffix = "expct"@@ -55,7 +59,7 @@ paramsAssocTests :: [TT.TestTree] paramsAssocTests = let (sugar1,_s1desc) = findSugarIn sugarCube sample- in [ testCase "valid sample" $ 14 @=? length sample+ in [ testCase "valid sample" $ 13 @=? length sample , sugarTestEq "correct found count" sugarCube sample 6 length , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in@@ -69,18 +73,17 @@ Expectation { expectedFile = p "recursive.fast.expct" , expParamsMatch = [ ("optimization", Explicit "fast")- , ("c-compiler", Assumed "gcc")+ , ("c-compiler", Assumed "clang") ] , associated = [ ("rust-source", p "recursive.rs") ] } , Expectation { expectedFile = p "recursive.fast.expct" , expParamsMatch = [ ("optimization", Explicit "fast")- , ("c-compiler", Assumed "clang")+ , ("c-compiler", Assumed "gcc") ] , associated = [ ("rust-source", p "recursive.rs") ] }- ] } @@ -141,14 +144,14 @@ [ Expectation { expectedFile = p "simple.expct" , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "gcc")+ , ("c-compiler", Assumed "clang") ] , associated = [ ("c-source", p "simple.c")] } , Expectation { expectedFile = p "simple.expct" , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "clang")+ , ("c-compiler", Assumed "gcc") ] , associated = [ ("c-source", p "simple.c")] }@@ -166,14 +169,14 @@ [ Expectation { expectedFile = p "simple.expct" , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "gcc")+ , ("c-compiler", Assumed "clang") ] , associated = [ ("c-source", p "simple.c")] } , Expectation { expectedFile = p "simple.expct" , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "clang")+ , ("c-compiler", Assumed "gcc") ] , associated = [ ("c-source", p "simple.c")] }
test/TestSingleAssoc.hs view
@@ -17,7 +17,7 @@ sugarCube = mkCUBE { rootName = "*.c" , expectedSuffix = "expected"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("exe", "exe") ] , validParams = [ ("arch", Just ["x86", "ppc"]) , ("form", Just ["base", "refined"])@@ -26,15 +26,15 @@ singleAssocTests :: [TT.TestTree] singleAssocTests =- let (sugar1,_s1desc) = findSugarIn sugarCube sample1+ let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 testInpPath) in [ -- This is simply the number of entries in sample1; if this -- fails in means that sample1 has been changed and the other -- tests here are likely to need updating.- testCase "valid sample" $ 58 @=? length sample1+ testCase "valid sample" $ 57 @=? length (sample1 testInpPath) - , sugarTestEq "correct found count" sugarCube sample1 6 length+ , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in@@ -46,31 +46,31 @@ , expected = [ Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"), ("form", Assumed "base")]- , associated = [ ("exe", p "global-max-good.x86.exe")+ , associated = [ ("exe", p "global-max-good.ppc.exe") ] } , Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),+ { expectedFile = p "global-max-good.ppc.expected"+ , expParamsMatch = [("arch", Explicit "ppc"), ("form", Assumed "refined")]- , associated = [ ("exe", p "global-max-good.x86.exe")+ , associated = [ ("exe", p "global-max-good.ppc.exe") ] } , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"), ("form", Assumed "base")]- , associated = [ ("exe", p "global-max-good.ppc.exe")+ , associated = [ ("exe", p "global-max-good.x86.exe") ] } , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),+ { expectedFile = p "global-max-good.x86.expected"+ , expParamsMatch = [("arch", Explicit "x86"), ("form", Assumed "refined")]- , associated = [ ("exe", p "global-max-good.ppc.exe")+ , associated = [ ("exe", p "global-max-good.x86.exe") ] } ]@@ -82,6 +82,20 @@ , cubeParams = validParams sugarCube , expected = [ Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "base") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ ]+ }+ , Expectation+ { expectedFile = p "jumpfar.ppc.expected"+ , expParamsMatch = [ ("arch" , Explicit "ppc")+ , ("form" , Assumed "refined") ]+ , associated = [ ("exe", p "jumpfar.ppc.exe")+ ]+ }+ , Expectation { expectedFile = p "jumpfar.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "base") ]@@ -95,28 +109,28 @@ , associated = [ ("exe", p "jumpfar.x86.exe") ] }- , Expectation- { expectedFile = p "jumpfar.ppc.expected"+ ]+ }+ , Sweets { rootMatchName = "looping.c"+ , rootBaseName = "looping"+ , rootFile = p "looping.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ]- , associated = [ ("exe", p "jumpfar.ppc.exe")+ , associated = [ ("exe", p "looping.ppc.exe") ] } , Expectation- { expectedFile = p "jumpfar.ppc.expected"+ { expectedFile = p "looping.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "refined") ]- , associated = [ ("exe", p "jumpfar.ppc.exe")+ , associated = [ ("exe", p "looping.ppc.exe") ] }- ]- }- , Sweets { rootMatchName = "looping.c"- , rootBaseName = "looping"- , rootFile = p "looping.c"- , cubeParams = validParams sugarCube- , expected =- [ Expectation+ , Expectation { expectedFile = p "looping.x86.expected" , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "base") ]@@ -130,28 +144,28 @@ , associated = [ ("exe", p "looping.x86.exe") ] }- , Expectation- { expectedFile = p "looping.ppc.expected"+ ]+ }+ , Sweets { rootMatchName = "looping-around.c"+ , rootBaseName = "looping-around"+ , rootFile = p "looping-around.c"+ , cubeParams = validParams sugarCube+ , expected =+ [ Expectation+ { expectedFile = p "looping-around.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "base") ]- , associated = [ ("exe", p "looping.ppc.exe")+ , associated = [ ("exe", p "looping-around.ppc.exe") ] } , Expectation- { expectedFile = p "looping.ppc.expected"+ { expectedFile = p "looping-around.ppc.expected" , expParamsMatch = [ ("arch" , Explicit "ppc") , ("form" , Assumed "refined") ]- , associated = [ ("exe", p "looping.ppc.exe")+ , associated = [ ("exe", p "looping-around.ppc.exe") ] }- ]- }- , Sweets { rootMatchName = "looping-around.c"- , rootBaseName = "looping-around"- , rootFile = p "looping-around.c"- , cubeParams = validParams sugarCube- , expected =- [ Expectation+ , Expectation { expectedFile = p "looping-around.expected" , expParamsMatch = [ ("arch", Assumed "x86") , ("form", Assumed "base") ]@@ -165,20 +179,6 @@ , associated = [ ("exe", p "looping-around.x86.exe") ] }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "base") ]- , associated = [ ("exe", p "looping-around.ppc.exe")- ]- }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , associated = [ ("exe", p "looping-around.ppc.exe")- ]- } ] } , Sweets { rootMatchName = "switching.c"@@ -187,25 +187,25 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "switching.x86.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "x86")+ { expectedFile = p "switching.ppc.base-expected"+ , expParamsMatch = [ ("arch", Explicit "ppc")+ , ("form", Explicit "base") ]- , associated = [ ("exe", p "switching.x86.exe")+ , associated = [ ("exe", p "switching.ppc.exe") ] } , Expectation- { expectedFile = p "switching.ppc.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "ppc")+ { expectedFile = p "switching.x86.base-expected"+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Explicit "base") ]- , associated = [ ("exe", p "switching.ppc.exe")+ , associated = [ ("exe", p "switching.x86.exe") ] } , Expectation { expectedFile = p "switching.x86.refined-expected"- , expParamsMatch = [ ("form", Explicit "refined")- , ("arch", Explicit "x86")+ , expParamsMatch = [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ] , associated = [ ("exe", p "switching.x86.exe") ]@@ -218,31 +218,31 @@ , cubeParams = validParams sugarCube , expected = [ Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc"), ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")+ , associated = [ ("exe", p "tailrecurse.ppc.exe") ] } , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")+ { expectedFile = p "tailrecurse.expected"+ , expParamsMatch = [ ("arch", Assumed "ppc") , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")+ , associated = [ ("exe", p "tailrecurse.ppc.exe") ] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86"), ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")+ , associated = [ ("exe", p "tailrecurse.x86.exe") ] } , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")+ { expectedFile = p "tailrecurse.x86.expected"+ , expParamsMatch = [ ("arch", Explicit "x86") , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")+ , associated = [ ("exe", p "tailrecurse.x86.exe") ] } ]
test/TestStrlen2.hs view
@@ -21,7 +21,7 @@ sugarCube = mkCUBE { rootName = "*.c" , expectedSuffix = "good"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("config", "config") , ("stdio", "print") ]@@ -31,7 +31,7 @@ strlen2SampleTests :: [TT.TestTree] strlen2SampleTests = let (sugar,sdesc) = findSugarIn sugarCube strlen2Samples- in [ testCase "valid sample" $ 25 @=? length strlen2Samples+ in [ testCase "valid sample" $ 24 @=? length strlen2Samples , sugarTestEq "correct found count" sugarCube strlen2Samples 1 length , testCaseSteps "sweets info" $ \step -> do@@ -118,24 +118,36 @@ , associated = [ ("stdio", p "strlen_test2.print") ] }- , Expectation- { expectedFile = p "strlen_test2.loopmerge.good"- , expParamsMatch = [ ("loop-merging", Explicit "loopmerge")- , ("solver", Assumed "z3")- ]- , associated = [ ("config", p "strlen_test2.loopmerge.config")- , ("stdio", p "strlen_test2.print")- ]- }+ -- Note that there exists strlen_test2.z3.good and+ -- strlen_test2.loopmerge.good, so this will create Expectations+ -- against _each_ file with different sets of Assumed and Explicit+ -- parameters.+ --+ -- The removeNonExplicitMatchingExpectations function will then try to+ -- select which one has the least number of explicit matches, but one is+ -- always Explicit and one is always Assumed. The resuilt then comes+ -- down to a comparison of the values, and "loopmerge" < "z3", so "z3"+ -- is selected as the _maximum_ (i.e. best) match.+ --+ -- Thus, the following Expectation is eliminated.+ --+ -- , Expectation+ -- { expectedFile = p "strlen_test2.loopmerge.good"+ -- , expParamsMatch = [ ("loop-merging", Explicit "loopmerge")+ -- , ("solver", Assumed "z3")+ -- ]+ -- , associated = [ ("config", p "strlen_test2.loopmerge.config")+ -- , ("stdio", p "strlen_test2.print")+ -- ]+ -- } ] ] --- Note that there exists strlen_test2.z3.good and--- strlen_test2.loopmerge.good, so this will create Expectations--- against _each_ file with different sets of Assumed and Explicit--- parameters.--strlen2Samples = lines [r|+strlen2Samples = fmap (\f -> CandidateFile { candidateDir = "test-data/samples"+ , candidateSubdirs = []+ , candidateFile = f })+ $ filter (not . null)+ $ lines [r| strlen_test2.boolector.boolector.out strlen_test2.boolector.boolector.print.out strlen_test2.boolector.good
test/TestUtils.hs view
@@ -24,12 +24,19 @@ Gen.string (Range.linear 0 3) Gen.alpha assocs <- Gen.list (Range.linear 0 10) assoc params <- Gen.list (Range.linear 0 5) param- return $ CUBE inpDir srcName expSfx seps [] []+ return $ mkCUBE { inputDirs = [ inpDir ]+ , rootName = srcName+ , expectedSuffix = expSfx+ , separators = seps+ , associatedNames = []+ , validParams = []+ } where assoc = (,) <$> someStr <*> someStr param = (,) <$> someStr <*> Gen.maybe (Gen.list (Range.linear 1 6) someStr) someStr = Gen.string (Range.linear 0 10) Gen.alpha + testWithFailInfo desc test testInp = E.catch (test testInp) (\(_e::E.SomeException) -> assertFailure (show desc)) @@ -101,7 +108,7 @@ else map (showEnt "expected") expUnique) <> (if null gotUnique then [Nothing]- else map (showEnt "actual") gotUnique)+ else map (showEnt "ACTUAL") gotUnique) sugarTest name cube sample test = let (r,d) = findSugarIn cube sample
test/TestWildcard.hs view
@@ -19,10 +19,14 @@ import Text.RawString.QQ -testInpPath = "test/samples"+testInpPath = "some/path/to/test/samples" -sample1 = lines [r|+sample1 = fmap (\f -> CandidateFile { candidateDir = testInpPath+ , candidateSubdirs = []+ , candidateFile = f })+ $ filter (not . null)+ $ lines [r| foo foo.exp foo.ex@@ -41,7 +45,7 @@ wildcardAssocTests :: [TT.TestTree] wildcardAssocTests =- [ testCase "valid sample" $ 14 @=? length sample1+ [ testCase "valid sample" $ 13 @=? length sample1 -- The first CUBE uses the default set of separators, and the expected -- suffix does not limit which separators can preceed the suffix.@@ -49,7 +53,7 @@ let sugarCube = mkCUBE { rootName = "*" , expectedSuffix = "exp"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)@@ -149,7 +153,7 @@ { rootName = "*" , expectedSuffix = "exp" , separators = ""- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)@@ -200,7 +204,7 @@ let sugarCube = mkCUBE { rootName = "*" , expectedSuffix = ".exp"- , inputDir = testInpPath+ , inputDirs = [ testInpPath ] , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)
test/internals/test-internals.hs view
@@ -148,6 +148,24 @@ , expParamsMatch = [ ("foo", Explicit "a") , ("cow", Explicit "moo")+ -- Explicit "moo" here against Assumed "moo" plus two+ -- more explicits... this gets removed+ ]+ , associated = []+ }+ ]+ test l = pCmpExp (take 1 adding <> init sample)+ (removeNonExplicitMatchingExpectations l)+ in mapM test (L.permutations $ adding <> sample)+ >> return ()++ , testCase "distinct if different" $+ let adding = [ Expectation+ { expectedFile = "test.file"+ , expParamsMatch =+ [ ("foo", Explicit "a")+ , ("bar", Explicit "bell")+ , ("cow", Assumed "moo") ] , associated = [] }