tasty-sugar 1.3.0.2 → 2.0.0.0
raw patch · 22 files changed
+2221/−2861 lines, 22 filesdep +containersdep +paralleldep ~directoryPVP ok
version bump matches the API change (PVP)
Dependencies added: containers, parallel
Dependency ranges changed: directory
API changes (from Hackage documentation)
+ Test.Tasty.Sugar: [candidateMatchIdx] :: CandidateFile -> Natural
+ Test.Tasty.Sugar: [candidatePMatch] :: CandidateFile -> [NamedParamMatch]
+ Test.Tasty.Sugar: findCandidates :: CUBE -> FilePath -> IO [Either String CandidateFile]
+ Test.Tasty.Sugar: makeCandidate :: CUBE -> FilePath -> [String] -> FilePath -> CandidateFile
- Test.Tasty.Sugar: CandidateFile :: FilePath -> [FilePath] -> FilePath -> CandidateFile
+ Test.Tasty.Sugar: CandidateFile :: FilePath -> [FilePath] -> FilePath -> [NamedParamMatch] -> Natural -> CandidateFile
Files
- CHANGELOG.md +19/−0
- src/Test/Tasty/Sugar.hs +16/−46
- src/internal/Test/Tasty/Sugar/Analysis.hs +42/−20
- src/internal/Test/Tasty/Sugar/AssocCheck.hs +23/−72
- src/internal/Test/Tasty/Sugar/Candidates.hs +218/−0
- src/internal/Test/Tasty/Sugar/ExpectCheck.hs +166/−174
- src/internal/Test/Tasty/Sugar/Iterations.hs +64/−0
- src/internal/Test/Tasty/Sugar/ParamCheck.hs +48/−196
- src/internal/Test/Tasty/Sugar/RootCheck.hs +0/−270
- src/internal/Test/Tasty/Sugar/Types.hs +52/−23
- tasty-sugar.cabal +11/−2
- test/Sample1.hs +3/−6
- test/TestFileSys.hs +658/−1110
- test/TestGCD.hs +45/−79
- test/TestMultiAssoc.hs +113/−193
- test/TestNoAssoc.hs +108/−147
- test/TestParamsAssoc.hs +289/−123
- test/TestSingleAssoc.hs +75/−167
- test/TestStrlen2.hs +88/−75
- test/TestUtils.hs +37/−2
- test/TestWildcard.hs +125/−140
- test/internals/test-internals.hs +21/−16
CHANGELOG.md view
@@ -1,5 +1,24 @@ # Revision history for tasty-sugar +## 2.0++ * Performance improvements. Now scales better when there are more parameters.++ * Improved expected and associated file matching and Expected results parameter+ identification. This may result in different results than the 1.x version of+ tasty-sugar!++ * Parameter values explicit in the root match but not in the expected file are+ now reported as Explicit in the expParamsMatch because they explicitly match+ part of one of the filenames. This also means that files which were+ previously provided as expectations are no longer matched because the better+ root parameter matches exclude them.++ * Expectations are selected by best ParamMatch values, in order of parameter+ name, with ties resolved in favor of the longest expected filename.++ * The --showsearch can now also report internal stats for tasty-sugar.+ ## 1.3.0.2 -- 2022-09-06 * Add test files to cabal's `extra-sources` so they are included in the package
src/Test/Tasty/Sugar.hs view
@@ -74,6 +74,8 @@ , ParameterPattern , mkCUBE , CandidateFile(..)+ , makeCandidate+ , findCandidates -- ** Output , Sweets(..) , Expectation(..)@@ -92,24 +94,23 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Logic+import Data.Either ( lefts, rights ) import qualified Data.Foldable as F import Data.Function import qualified Data.List as L+import qualified Data.Map as Map import Data.Maybe ( isJust, isNothing, fromJust ) import Data.Proxy import qualified Data.Text as T import Data.Typeable ( Typeable ) import Numeric.Natural ( Natural ) import Prettyprinter-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 import Test.Tasty.Sugar.Analysis+import Test.Tasty.Sugar.Candidates import Test.Tasty.Sugar.Report import Test.Tasty.Sugar.Types @@ -176,50 +177,14 @@ findSugar cube = fst <$> findSugar' cube findSugar' :: MonadIO m => CUBE -> m ([Sweets], Doc ann)-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+findSugar' pat = do+ candidates <- liftIO (concat+ <$> (mapM (findCandidates pat) $ L.filter (not . null) $ L.nub $ inputDir pat : inputDirs pat))+ mapM_ (liftIO . hPutStrLn stderr . ("WARNING: " <>)) $ lefts candidates+ return $ findSugarIn pat $ rights candidates -- | Given a list of filepaths and a CUBE, returns the list of matching@@ -232,7 +197,7 @@ findSugarIn :: CUBE -> [CandidateFile] -> ([Sweets], Doc ann) findSugarIn pat allFiles =- let (nCandidates, sres) = checkRoots pat allFiles+ let (nCandidates, sres, stats) = checkRoots pat allFiles inps = concat $ fst <$> sres expl = vsep $ [ "Checking for test inputs in:" <+>@@ -247,6 +212,11 @@ pretty (length sres) , "parameters = " <+> pretty (validParams pat) ] <> ((("--?" <+>) . pretty) <$> (concatMap snd sres))+ <> if null stats+ then []+ else [ "", "Stats:" ]+ <> ((\(k,v) -> " #" <+> pretty k <+> " = " <> pretty v)+ <$> Map.toList stats) ] in case cubeIsValid pat of Right _ -> (L.sortBy (compare `on` rootFile) inps, expl)
src/internal/Test/Tasty/Sugar/Analysis.hs view
@@ -9,7 +9,7 @@ ) where -import Control.Monad.Logic+import Control.Parallel.Strategies import Data.Bifunctor ( bimap ) import Data.Function ( on ) import qualified Data.List as L@@ -18,23 +18,29 @@ import qualified System.FilePath.GlobPattern as FPGP import Test.Tasty.Sugar.ExpectCheck-import Test.Tasty.Sugar.RootCheck+import Test.Tasty.Sugar.Iterations import Test.Tasty.Sugar.ParamCheck ( pmatchCmp ) import Test.Tasty.Sugar.Types +import Prelude hiding ( exp ) + -- | 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])])+ -> (Int, [([Sweets], [SweetExplanation])], IterStat) checkRoots pat allFiles = 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)+ -- roots is all *possible* roots, but some of these are not roots at all,+ -- and some of these may be the other files associated with a root, so+ -- "root" files cannot be eliminated from the search space yet.+ roots = L.filter isRootMatch allFiles+ allSweets = (checkRoot pat allFiles) <$> roots+ checked = filter (not . null . fst) (fst <$> allSweets)+ allStats = foldr joinStats emptyStats (snd <$> allSweets)+ in (length checked, checked, allStats) -- checkRoot will attempt to split the identified root file into three@@ -49,13 +55,36 @@ checkRoot :: CUBE -> [CandidateFile] -- all possible expect candidates -> CandidateFile -- root path- -> ([Sweets], [SweetExplanation])+ -> (([Sweets], [SweetExplanation]), IterStat) checkRoot pat allFiles rootF =- let seps = separators pat- params = validParams pat+ let params = L.sort $ validParams pat combineExpRes (swts, expl) = bimap (swts :) (expl :) - mergeSweets swl =+ roots = [( candidatePMatch rootF+ , rootF { candidateFile =+ -- truncate the candidateFile to the first separator+ -- point preceeding parameter matches.+ let i = fromEnum $ candidateMatchIdx rootF+ l = length $ candidateFile rootF+ e = l > 0 && last (candidateFile rootF) `elem` (separators pat)+ t = if i == l && not e then i else i - 1+ in take t (candidateFile rootF) }+ )+ , (candidatePMatch rootF, rootF)+ ]++ expAndStats = parMap rpar (findExpectation pat params rootF allFiles) roots++ sumStats = foldr joinStats emptyStats (snd <$> expAndStats)+ exps = foldr combineExpRes (mempty, mempty) $ mergeSweets+ $ catMaybes (fst <$> expAndStats)++ in (exps, sumStats)+++mergeSweets :: Foldable t+ => t (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)]+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:@@ -91,19 +120,12 @@ let swts = s { expected = foldr mergeExp (expected s) (expected sm) }- mergeExp oneExp exps =+ mergeExp oneExp expcts = concat $ fmap (take 1) $ L.groupBy ((==) `on` (fmap (fmap getParamVal) . expParamsMatch)) $ L.sortBy (pmatchCmp `on` expParamsMatch)- $ oneExp : exps+ $ oneExp : expcts in ( swts, e { results = swts } ) in foldr combineIfRootsMatch [] swl-- in foldr combineExpRes ([], []) $- mergeSweets $- catMaybes $- fmap (findExpectation pat rootF allFiles) $- observeAll $- rootMatch rootF seps params (rootName pat)
src/internal/Test/Tasty/Sugar/AssocCheck.hs view
@@ -2,6 +2,7 @@ -- identified test root file. {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} module Test.Tasty.Sugar.AssocCheck (@@ -9,10 +10,12 @@ ) where -import Control.Monad.Logic-import qualified Data.List as L-import Data.Maybe ( catMaybes )+import Control.Monad ( guard )+import Data.Function ( on )+import qualified Data.List as DL +import Test.Tasty.Sugar.Candidates+import Test.Tasty.Sugar.Iterations import Test.Tasty.Sugar.ParamCheck import Test.Tasty.Sugar.Types @@ -26,79 +29,27 @@ -> [NamedParamMatch] -> [ (String, FileSuffix) ] -> [CandidateFile]- -> Logic [(String, CandidateFile)]+ -> LogicI [(String, CandidateFile)] getAssoc rootPrefix seps pmatch assocNames allNames = assocSet where+ assocSet = concat <$> mapM fndBestAssoc assocNames fndBestAssoc :: (String, FileSuffix)- -> Logic [(String, CandidateFile)] -- usually just one- fndBestAssoc assoc =- do let candidates = L.nub $ catMaybes $- observeAll (fndAnAssoc assoc)- let highestRank = maximum (fst <$> candidates)- c = filter ((== highestRank) . fst) candidates- if null candidates- then return []- else return (snd <$> c)-- fndAnAssoc :: (String, FileSuffix)- -> Logic (Maybe (Int, (String, CandidateFile)))- fndAnAssoc assoc = ifte (fndAssoc assoc)- (return . Just)- (return Nothing)+ -> LogicI [(String, CandidateFile)] -- usually just one+ fndBestAssoc assoc = addSubLogicStats (observeIT (fndAssoc assoc)) - fndAssoc :: (String, FileSuffix) -> Logic (Int, (String, CandidateFile))+ fndAssoc :: (String, FileSuffix) -> LogicI (String, CandidateFile) fndAssoc assoc =- do pseq <- npseq pmatch- (rank, assocPfx, assocSfx) <- sepParams seps (fmap snd pseq)- 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 =- let rank (n,_,_) = n- pfx (_,l,_) = l- in \case- [] -> if null sl- then return (0, [], [])- else do s <- eachFrom sl- return (0, [s], [])- (NotSpecified:ps) -> do r <- sepParams sl ps- return (rank r, [], pfx r)- ((Explicit v):ps) -> do (n,l,r) <- sepParams sl ps- if null sl- then return (n+1, v <> l, r)- else do s <- eachFrom sl- return (n+1, [s] <> v <> l, r)- ((Assumed v):ps) -> do (n,l,r) <- sepParams sl ps- if null sl- then return (n+1, v <> l, r)- else do s <- eachFrom sl- return (n+1, [s] <> v <> l, r)-- npseq = eachFrom- . ([]:) -- consider no parameters just once- . filter (not . null) -- excluding multiple blanks in- . concatMap L.inits -- any number of the- . L.permutations -- parameters in each possible order+ -- First, eliminate any files that don't start with rootPrefix or end in+ -- this assoc suffix (do this before trying any backtracking).+ do let sfxMatch cf =+ and [ candidateMatchPrefix seps rootPrefix cf+ , candidateMatchSuffix seps (snd assoc) rootPrefix cf+ ]+ assocNms = DL.reverse+ $ DL.sortBy (compare `on` (matchStrength . fmap snd . candidatePMatch))+ $ filter sfxMatch allNames+ afile <- eachFrom "assoc candidate" assocNms+ guard (isCompatible (fmap getParamVal <$> pmatch) afile)+ return (fst assoc, afile)
+ src/internal/Test/Tasty/Sugar/Candidates.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module Test.Tasty.Sugar.Candidates+ (+ candidateToPath+ , findCandidates+ , makeCandidate+ , candidateMatchPrefix+ , candidateMatchSuffix+ )+where++import Control.Monad ( filterM, guard )+import Data.Bifunctor ( first )+import qualified Data.List as DL+import Data.Maybe ( fromMaybe, isNothing )+import Numeric.Natural+import System.Directory ( doesDirectoryExist, getCurrentDirectory+ , listDirectory, doesDirectoryExist )+import System.FilePath ( (</>), isRelative, makeRelative+ , splitPath, takeDirectory, takeFileName)++import Test.Tasty.Sugar.Iterations+import Test.Tasty.Sugar.Types+++findCandidates :: CUBE -> FilePath -> IO ([Either String CandidateFile])+findCandidates cube inDir =+ 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 = makeCandidate cube d []+ return (Right . mkC <$> dirContents)+ Just topdir -> do+ let subs = filter (not . null)+ (init+ <$> init (splitPath+ $ makeRelative topdir (d </> "x")))+ let mkC = makeCandidate cube topdir subs+ subdirs <- filterM (doesDirectoryExist . (d </>)) dirContents+ let here = Right . 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+ return [Left $ showD <> " does not exist"]+ in collectDirEntries inDir+++-- | Create a CandidateFile entry for this top directory, sub-paths, and+-- filename. In addition, any Explicit parameters with known values that appear+-- in the filename are captured. Note that:+--+-- * There may be multiple possible matches for a single parameter (e.g. the+-- value is repeated in the name or path, or an undefind value (Nothing)+-- parameter could have multiple possible values extracted from the filename.+--+-- * File name matches are preferred over sub-path matches and will occlude the+-- latter.+--+-- * All possible filename portions and sub-paths will be suggested for non-value+-- * parameters (validParams with Nothing).+--+makeCandidate :: CUBE -> FilePath -> [String] -> FilePath -> CandidateFile+makeCandidate cube topDir subPath fName =+ let fl = DL.length fName+ isSep = (`elem` separators cube)+ firstSep = maybe fl (+1) $ DL.findIndex isSep fName+ fle = maybe fl (fl-) $ DL.findIndex isSep $ DL.reverse fName+ -- pmatches is all known parameter values found in the name or directory of+ -- the file. Note that a single parameter with multiple values may result+ -- in multiple pmatches if more than one of the values is present in a+ -- single filename.+ pmatches = fst $ observeIAll+ $ do p <- eachFrom "param for candidate" $ validParams cube+ v <- eachFrom "value for param" (fromMaybe [] (snd p))+ -- Note: there maybe multiple v values for a single p that+ -- are matched in the name. This is accepted here (and+ -- this file presumably satisfies either with an Explicit+ -- match).+ let vl = DL.length v+ i <- eachFrom "param starts"+ $ DL.findIndices (`elem` (separators cube)) fName+ let vs = i + 1+ let ve = vs + vl+ if and [ ve + 1 < fl -- v fits in fName[i..]+ , v == DL.take vl (DL.drop vs fName)+ , head (DL.drop ve fName) `elem` (separators cube)+ ]+ then return ((fst p, Explicit v), (toEnum vs, ve))+ else do guard $ v `elem` subPath+ return ((fst p, Explicit v), (0, 0))+ -- pmatchArbitrary will find a parameter with an unspecified value and+ -- assigned otherwise unmatched portions of the filename to that parameter.+ pmatchArbitrary =+ case DL.find (isNothing . snd) $ validParams cube of+ Nothing -> []+ Just (p,_) ->+ let chkRange = [(firstSep, fle)]+ -- arbs is the (start,len) spans where arbitrary values could+ -- occur+ arbs = holes chkRange (snd <$> pmatches)+ -- getRange extracts a substring range from the fName+ getRange (s,e) = let s' = fromEnum s+ in DL.take (e - s' - 1) $ DL.drop s' fName+ -- holeVals are the separator-divided values extracted from the+ -- arbs ranges of fName.+ holeVals = let neither f a b = not $ or [f a, f b]+ splitBySep = filter (not . all isSep)+ . DL.groupBy (neither isSep)+ rangeVals r = (,r) <$> (splitBySep $ getRange r)+ in+ concatMap rangeVals arbs+ -- dirVals are the subdirectory elements that could be used for+ -- arbitrary value matching (i.e. they don't explicitly match).+ dirVals =+ let pvals = getParamVal . snd . fst <$> pmatches+ in (, (0,0)) <$> filter (not . (`elem` pvals) . Just) subPath+ in (first ((p,) . Explicit)) <$> (holeVals <> dirVals)+ pAll = pmatches <> pmatchArbitrary+ dropSeps i =+ let lst = last $ DL.group $ DL.take (fromEnum i) fName+ in if isSep $ head lst+ then i - (toEnum (length lst) - 1)+ else i+ mtchIdx = dropSeps+ $ minimum+ $ toEnum fle+ : filter (/= 0) (fst . snd <$> pAll)+ in CandidateFile { candidateDir = topDir+ , candidateSubdirs = subPath+ , candidateFile = fName+ -- nub the results in case a v value appears twice in a single+ -- file. Sort the results for stability in testing.+ , candidatePMatch = DL.nub $ DL.sort $ (fst <$> pAll)+ , candidateMatchIdx = mtchIdx+ }+++-- Remove present from chkRange leaving holes.+holes :: [(Int,Int)] -> [(Natural,Int)] -> [(Natural,Int)]+holes chkRange present =+ let rmvKnown _ [] = []+ rmvKnown p@(ps,pe) ((s,e):rs) =+ if abs(ps-s) <= 1+ then if pe > e+ then rmvKnown (toEnum e,pe) rs+ else if abs(pe-e) <= 1+ then rs+ else (toEnum pe + 1, e) : rs+ else if ps >= s && fromEnum ps < e+ then if abs(pe - e) <= 1+ then (s, fromEnum ps) : rs+ else if pe < e+ then (s, fromEnum ps) : (toEnum pe, e) : rs+ else (s, fromEnum ps) : rmvKnown (toEnum e, pe) rs+ else rmvKnown p rs+ r' = filter (\x -> fst x /= snd x) chkRange+ in foldr rmvKnown (first toEnum <$> r') (DL.sort present)+++-- | This converts a CandidatFile into a regular FilePath for access+candidateToPath :: CandidateFile -> FilePath+candidateToPath c =+ candidateDir c </> foldr (</>) (candidateFile c) (candidateSubdirs c)+++-- | Determines if the second CandidateFile argument matches the prefix of the+-- first CandidateFile, up to any separator (if applicable). This can be used to+-- match possible expected files against the current root file, or possible+-- associated files against the current expected file.+candidateMatchPrefix :: Separators -> CandidateFile -> CandidateFile -> Bool+candidateMatchPrefix seps mf cf =+ let mStart = candidateFile mf+ mStartLen = length mStart+ f = candidateFile cf+ pfxlen = let cl = candidateMatchIdx cf+ in if fromEnum cl == length f+ then if null seps then toEnum mStartLen else cl+ else cl - 1+ in mStart == DL.take (fromEnum pfxlen) f+++candidateMatchSuffix :: Separators -> FileSuffix -> CandidateFile+ -> CandidateFile -> Bool+candidateMatchSuffix seps sfx rootf cf =+ let f = candidateFile cf+ sfxsep = not (null sfx) && head sfx `elem` seps+ in if null sfx+ then f == DL.takeWhile (not . (`elem` seps)) f+ else and [ length f >= (length (candidateFile rootf) + length sfx)+ , sfx `DL.isSuffixOf` f+ -- is char before sfx a separator (and fEnd didn't start+ -- with a separator)?+ , if null seps+ then length f == length (candidateFile rootf) + length sfx+ else if sfxsep+ then True+ else maybe False ((`elem` seps) . fst)+ $ DL.uncons+ $ DL.drop (length sfx)+ $ reverse f+ ]
src/internal/Test/Tasty/Sugar/ExpectCheck.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} -- | Function to find expected results files for a specific root file,@@ -7,15 +8,20 @@ module Test.Tasty.Sugar.ExpectCheck ( findExpectation- , removeNonExplicitMatchingExpectations+ , collateExpectations ) where +import Control.Applicative ( (<|>) ) import Control.Monad-import Control.Monad.Logic+import Data.Bifunctor ( first )+import Data.Function ( on ) import qualified Data.List as L+import Data.Maybe ( isNothing ) import Test.Tasty.Sugar.AssocCheck+import Test.Tasty.Sugar.Candidates+import Test.Tasty.Sugar.Iterations import Test.Tasty.Sugar.ParamCheck import Test.Tasty.Sugar.Types @@ -23,35 +29,37 @@ -- | Finds the possible expected files matching the selected -- source. There will be either one or none. findExpectation :: CUBE+ -> [ParameterPattern] -> 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 $- trimExpectations $- observeAll $- do guard (not $ null candidates)- expectedSearch- matchPrefix- rootPMatches seps params expSuffix o- candidates+ -> ([NamedParamMatch], CandidateFile) -- param constraints from the root name+ -> (Maybe ( Sweets, SweetExplanation ), IterStat)+findExpectation pat params rootN allNames (rootPMatches, matchPrefix) =+ let r = first (mkSweet . trimExpectations)+ $ observeIAll+ $ 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+ sfxMatch = if null expSuffix then const True else (expSuffix `L.isSuffixOf`) candidates = filter possible allNames possible f = and [ candidateFile matchPrefix `L.isPrefixOf` candidateFile f , rootN /= f ]- mkSweet e = Just $ Sweets { rootMatchName = candidateFile rootN- , rootBaseName = candidateFile matchPrefix- , rootFile = candidateToPath rootN- , cubeParams = validParams pat- , expected = e- }+ mkSweet e = Just+ $ Sweets { rootMatchName = candidateFile rootN+ , rootBaseName = candidateFile matchPrefix+ , rootFile = candidateToPath rootN+ , cubeParams = validParams pat+ , expected = L.sortBy (compare `on` expectedFile) e+ } -- The expectedSearch tries various combinations and ordering of -- parameter values, separators, and such to find all valid@@ -62,7 +70,7 @@ trimExpectations = -- If a parameter is Explicitly matched, discard any -- Expectation with the same Assumed matches.- removeNonExplicitMatchingExpectations+ collateExpectations -- remove duplicates (uses the Eq instance for Expectation -- that ignores the order of the expParamsMatch and associated -- to ensure that different ordering with the same values@@ -70,21 +78,24 @@ . L.nub in case r of- Nothing -> Nothing- Just r' | [] <- expected r' -> Nothing- Just r' -> Just ( r'- , SweetExpl { rootPath = candidateToPath rootN- , base = candidateToPath matchPrefix- , expectedNames =- filter- (if null expSuffix then const True- else (expSuffix `L.isSuffixOf`))- (candidateToPath <$> candidates)- , results = r'- })+ (Nothing, stats) -> (Nothing, stats)+ (Just r', stats) | [] <- expected r' -> (Nothing, stats)+ (Just r', stats) ->+ ( Just ( r'+ , SweetExpl { rootPath = candidateToPath rootN+ , base = candidateToPath matchPrefix+ , expectedNames =+ filter sfxMatch (candidateToPath <$> candidates)+ , results = r'+ })+ , stats ) --- Find all Expectations matching this rootMatch+-- Find all Expectations matching this rootMatch.+--+-- Note that rootPVMatches may contain multiple entries for the same parameter+-- value: the root file name may contain these duplications. The code here+-- should be careful to check against each value instead of assuming just one. expectedSearch :: CandidateFile -> [NamedParamMatch] -> Separators@@ -92,159 +103,140 @@ -> FileSuffix -> [ (String, FileSuffix) ] -> [CandidateFile]- -> Logic Expectation+ -> LogicI Expectation 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),c) = (a,b,c)- in eachFrom $ L.nub $ fmap dropRank $ filter (rankMatching m) l+ do let expMatch cf = and [ candidateMatchPrefix seps rootPrefix cf+ , candidateMatchSuffix seps expSuffix rootPrefix cf+ ] - in bestRanked $- observeAll $- do pseq <- eachFrom $- ([] :) $- filter (not . null) $- concatMap L.inits $- L.permutations params'- pvals <- getPVals pseq- 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- }+ let unconstrained = fst <$> L.filter (isNothing . snd) params + -- Get the parameters matched by the root, and suggested values for the+ -- other parameters. This will backtrack through alternative values for+ -- each parameter. --- | 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 :: CandidateFile- -> [NamedParamMatch]- -> Separators- -> [ParameterPattern]- -> [(String, Maybe String)]- -> FileSuffix- -> [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.+ (rmatch, pvals) <- getSinglePVals rootPVMatches params+ -- If some of rootPVMatches were related to values that+ -- might have been useable for an unconstrained+ -- parameter, then we also need to consider roots that+ -- don't match those unconstrained values (because those+ -- might not be a match for that parameter):+ <|>+ (if null unconstrained+ then mzero+ else let unConstr = (`elem` unconstrained) . fst+ rm = L.filter (not . unConstr) rootPVMatches+ in if null rm+ then mzero+ else getSinglePVals rm params+ ) - 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+ efile <- eachFrom "exp candidate"+ $ L.reverse+ $ L.sortBy (compare `on` matchStrength . fmap snd . candidatePMatch)+ $ filter expMatch allNames+ guard $ isCompatible pvals efile - let inpDirMatches = fmap rootMatchesInSubdir <$> zip allNames allNames+ let onlyOneOfEach (p,v) r = case lookup p r of+ Nothing -> (p,v) : r+ Just _ -> r+ rAndeMatches <- return (foldr onlyOneOfEach rmatch (candidatePMatch efile))+ <|> (if null unconstrained+ then mzero+ else let unConstr = (`elem` unconstrained) . fst+ rm = filter (not . unConstr) (candidatePMatch efile)+ in if null rm+ then mzero+ else return (foldr onlyOneOfEach rmatch rm)+ ) - (dirName, inpDirMatch) <- eachFrom inpDirMatches+ let pmatch = namedPMatches rAndeMatches pvals+ assocFiles <- getAssoc rootPrefix seps+ pmatch+ assocNames allNames+ return $ Expectation { expectedFile = candidateToPath efile+ , associated = fmap candidateToPath <$> assocFiles+ , expParamsMatch = L.sort pmatch+ } - 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 suffixSepMatch = not suffixSpecifiesSep- || and [ not (null pmstr)- , last pmstr == head expSuffix- ]- guard suffixSepMatch-- let ending = if suffixSpecifiesSep then tail expSuffix else expSuffix-- expFile <-- eachFrom- $ filter (((candidateFile rootPrefix <> pmstr <> ending) ==) . candidateFile)- $ hereNames-- return (expFile, pmcnt, pm)-- -- | 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. -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+collateExpectations :: [Expectation] -> [Expectation]+collateExpectations allExps =+ let paramsAndVals = fmap (fmap getParamVal)+ . L.sortBy (compare `on` fst)+ . expParamsMatch++ -- The matching named parameters should have matching values; there could+ -- be extra parameters in on or the other, but not both. Give more weight+ -- to Explicit matches, even those not present in the other match. This+ -- requires both a and b parameter lists to be sorted on parameter name.+ pvMatch a b =+ let pvCmp _ [] = True+ pvCmp ((xn,xv):xs) y@((yn,yv):ys) =+ if xn == yn+ then xv == yv && pvCmp xs ys+ else pvCmp xs y+ pvCmp [] _ = error "first argument must be longest list for pvMatch"+ in if length a > length b then pvCmp a b else pvCmp b a+ pvCompare a b =+ let pvCmpN n [] [] = (n, EQ)+ pvCmpN n ((_,xv):xs) [] = const GT <$> pvCmpN (n + weight xv) xs []+ pvCmpN n [] _ = (n, LT)+ pvCmpN n ((xn,xv):xs) y@((yn,yv):ys) =+ if xn == yn+ then case compare (getParamVal xv) (getParamVal yv) of+ EQ -> pvCmpN (n + weight xv - weight yv) xs ys+ o -> (n, o)+ else pvCmpN (n + weight xv) xs y+ pvCmp x y = case pvCmpN (0::Int) x y of+ (n, EQ) -> if n > 0+ then GT+ else if n < 0 then LT+ else compare x y+ (_, o) -> o+ weight = \case+ NotSpecified -> 0+ Assumed _ -> 0+ Explicit _ -> 1+ invertCmp = \case+ LT -> GT+ GT -> LT+ EQ -> EQ+ in if length a > length b+ then pvCmp a b+ else invertCmp $ pvCmp b a++ -- expGrps are expectations grouped by having the same parameter names and+ -- values (just the value, not the ParamMatch).+ expGrps = collectBy (pvMatch `on` paramsAndVals)+ $ L.reverse+ $ L.sortBy (compare `on` (length . expParamsMatch))+ $ allExps++ collectBy _ [] = []+ collectBy f (e:es) = let (s,d) = L.partition (f e) es+ in (e : s) : collectBy f d+ in+ -- For each group of expectations that have the same values, find the best of+ -- the group by ordering first on ParamMatch, and then resolving ties based+ -- on the length of the expected filename.+ concatMap (take 1+ -- Resolve ties by taking the longest filename+ . L.reverse+ . L.sortBy (compare `on` (length . expectedFile))+ -- Discard all but the best ParamMatch+ . L.reverse+ . head+ -- Group by equal ParamMatch (may be multiple files)+ . L.groupBy ((==) `on` expParamsMatch)+ -- Order this group by best ParamsMatch (Explicit) to worst+ . L.reverse+ . L.sortBy (pvCompare `on` expParamsMatch)+ ) expGrps
+ src/internal/Test/Tasty/Sugar/Iterations.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Tasty.Sugar.Iterations+where++import Control.Monad ( mplus, mzero )+import Control.Monad.Logic+import Control.Monad.State ( StateT, runStateT, modify )+import Data.Function ( on )+import Data.Functor.Identity ( Identity, runIdentity )+import qualified Data.List as DL+import qualified Data.Map as Map+import Data.Text ( Text )+++type IterStat = Map.Map Text Int++emptyStats :: IterStat+emptyStats = mempty++joinStats :: IterStat -> IterStat -> IterStat+joinStats = Map.unionWith (+)+++----------------------------------------------------------------------++type LogicI a = LogicT (StateT IterStat Identity) a++-- Note: stats collection can increase the runtime if the amount of backtracking+-- becomes significant. It can also increase runtime because a stats report+-- (from --showsearch) will force the evaluation of branches that might otherwise+-- have been lazily ignored. To disable the dilatory effects (and disable stats+-- collection), disable the modify statements in addSubLogicStats and eachFrom.++addSubLogicStats :: (a, IterStat) -> LogicI a+addSubLogicStats (r, stats) = do modify $ joinStats stats+ return r++observeIAll :: LogicI a -> ([a], IterStat)+observeIAll op = runIdentity $ runStateT (observeAllT op) emptyStats++observeIT :: LogicI a -> ([a], IterStat)+observeIT op = runIdentity $ runStateT (observeManyT 1 op) emptyStats++----------------------------------------------------------------------++-- | Core Logic function to iteratively return elements of a list via+-- backtracking.+eachFrom :: Text -> [a] -> LogicI a+eachFrom location =+ let attempt c a = do modify $ Map.insertWith (+) location 1+ return c `mplus` a+ in foldr attempt mzero+++-- | Given a list, return the list of lists representing all permutations of the+-- same length or shorter, removing any duplications, from longest to shortest+-- (shortest being the empty list).+combosLongToShort :: Eq a => [a] -> [ [a] ]+combosLongToShort = reverse+ . DL.sortBy (compare `on` length)+ . DL.nub+ . concatMap DL.inits+ . DL.permutations
src/internal/Test/Tasty/Sugar/ParamCheck.hs view
@@ -1,147 +1,64 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-} -- | Functions for checking different parameter/value combinations. module Test.Tasty.Sugar.ParamCheck (- eachFrom- , getPVals- , singlePVals- , pvalMatch- , removePVals+ getSinglePVals+ , namedPMatches , 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 qualified Data.List as DL import Test.Tasty.Sugar.Types----- | Core Logic function to iteratively return elements of a list via--- backtracking.-eachFrom :: [a] -> Logic a-eachFrom = foldr (mplus . return) mzero----- | Returns various combinations of parameter value selections-getPVals :: [ParameterPattern] -> Logic [(String, Maybe String)]-getPVals = mapM getPVal- where- getPVal (pn, Nothing) = return (pn, Nothing)- 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--- used to match against input files.------ Note that valid combinations require that if a parameter is--- non-Explicit, all following parameters must also be non-Explicit.------ The preset set of parameters are any parameters *already* matched--- against (usually in the rootName); these parameters may or may not--- be present in the filename matched from the output of this--- function, but if they are present, they must have the values--- specified in the preset (instead of having any of the possible--- values allowed for that parameter).------ It's also possible that since this returns varying combinations of--- parameters, that there may be multiple files that will match--- against these combinations. Therefore, the results also indicate--- how many of the parameters are used in the associated matching--- string since the caller will usually select the match with the--- highest ranking (number of matched parameters) in the filename.--- [Note that it is not possibly to simply use the length of the--- @[NamedParamMatch]@ return component since that may contain values--- from the preset that don't actually occur in the match string.-pvalMatch :: Separators- -> [NamedParamMatch]- -> [(String, Maybe String)]- -> Logic ([NamedParamMatch], Int, String)-pvalMatch seps preset pvals =- let (ppv, _rpv) = L.partition isPreset pvals- isPreset p = fst p `elem` (fmap fst preset)-- matchesPreset = all matchPreset ppv- matchPreset (pn,mpv) = maybe False (matchPresetVal mpv) $- lookup pn preset- matchPresetVal mpv pv = case mpv of- Just v -> paramMatchVal v pv- Nothing -> True-- genPVStr :: [NamedParamMatch] -> Logic String- genPVStr pvs =- let vstr = fromMaybe "" . getExplicit . snd- sepJoin :: String -> NamedParamMatch -> Logic String- sepJoin r v = if isExplicit (snd v)- then do s <- eachFrom seps- return $ [s] <> vstr v <> r- else return r- in if null seps- then return $ foldr (\v r -> vstr v <> r) "" pvs- else do s <- eachFrom seps- foldM sepJoin [s] pvs-- 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)+import Test.Tasty.Sugar.Iterations ( LogicI, eachFrom ) --- | Generate the various combinations of parameters+values from the possible--- set specified by the input.+-- | Return a value to use for each parameter in the pattern, retricting those+-- values to the name parameter matches already established. This is a little+-- more complicated because there could be parameter name duplicates in the+-- already established matches (e.g. a matched file contains multiple values for+-- a parameter), so the actual subset of the named parameter matches associated+-- with this pattern selection is also returned. -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+getSinglePVals :: [NamedParamMatch] -> [ParameterPattern]+ -> LogicI ([NamedParamMatch], [(String, Maybe String)])+getSinglePVals sel = fmap (fmap DL.sort) . foldM eachVal (mempty, mempty)+ where eachVal (an,av) (pn, Nothing) =+ case filter ((pn ==) . fst) sel of+ [] -> return (an, (pn, Nothing) : av)+ pvsets -> do npv <- snd <$> eachFrom "assigned param value" pvsets+ return ((pn, npv) : an, (pn, getParamVal npv) : av)+ eachVal (an,av) (pn, Just pvs) =+ case filter ((pn ==) . fst) sel of+ [] -> do pv <- eachFrom "assumed (non-root) param value" $ DL.sort pvs+ return (an, (pn, Just pv) : av)+ pvsets -> do npv <- eachFrom "matched param value" (snd <$> pvsets)+ return ((pn, npv) : an, (pn, getParamVal npv) : av) --- | 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.+-- | namedPMatches supplements the core set of named matches with the extended+-- set of parameter values, marking all parameters not in the core set as Assumed+-- or NotSpecified. -removePVals :: [(String, a)] -> [(String, b)] -> [(String, a)]-removePVals main rmv = filter (not . (`elem` (fst <$> rmv)) . fst) main+namedPMatches :: [NamedParamMatch] -> [(String, Maybe String)]+ -> [NamedParamMatch]+namedPMatches pmatch =+ let inCore = (`elem` (fst <$> pmatch))+ go = \case+ [] -> pmatch+ ((p, Just v):r) | not (inCore p) -> (p, Assumed v) : go r+ ((p, Nothing):r) | not (inCore p) -> (p, NotSpecified) : go r+ (_:r) -> go r+ in go -- | This provides an Ordering result of comparing two sets of NamedParamMatch.@@ -156,7 +73,7 @@ -- the one with more parameters (usually the same) , compare `on` length -- comparing keys- , compare `on` (L.sort . fmap fst)+ , compare `on` (DL.sort . fmap fst) ] -- comparing the correlated ParamMatch values <> map (\k -> compare `on` (lookup k)) (fst <$> p1)@@ -168,6 +85,7 @@ 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). @@ -177,82 +95,16 @@ _ -> 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)]+isCompatible :: [(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+isCompatible pvals fname =+ let isCompatParam (n,v) = case DL.lookup n pvals of+ Nothing -> True+ Just Nothing -> True+ Just (Just cv) -> paramMatchVal cv v+ in all isCompatParam $ candidatePMatch fname
− src/internal/Test/Tasty/Sugar/RootCheck.hs
@@ -1,270 +0,0 @@--- | Function and associated helpers to determine the matching root--- name. The root name may contain zero or more parameter values.--{-# LANGUAGE LambdaCase #-}--module Test.Tasty.Sugar.RootCheck- (- rootMatch- )- where--import Control.Monad-import Control.Monad.Logic-import qualified Data.List as L-import Data.Maybe ( catMaybes, isNothing )--import Test.Tasty.Sugar.ParamCheck-import Test.Tasty.Sugar.Types----- | Determine which parts of the input name form the basePrefix and any--- 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- | RootParNm String String- | RootText String- | RootSuffix String- deriving Show--isRootParNm :: RootPart -> Bool-isRootParNm (RootParNm _ _) = True-isRootParNm _ = False--isRootSep :: RootPart -> Bool-isRootSep (RootSep _) = True-isRootSep _ = False--rpStr :: [RootPart] -> String-rpStr = let s = \case- RootSep x -> x- RootParNm _ x -> x- RootText x -> x- RootSuffix x -> x- 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)- 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 :: CandidateFile- -> Separators -> [ParameterPattern] -> String- -> Logic ([NamedParamMatch], CandidateFile, String)-rootParamMatch origRoot seps params rootCmp =- if null seps- then rootParamMatchNoSeps origRoot seps params- else rootParamFileMatches origRoot seps params rootCmp---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 ]- freeValueParm = L.find (isNothing . snd) parms-- txtRootSfx = sepSplit $ reverse $- -- Find the concrete extension in the- -- rootName. Somewhat crude, but basically stops at- -- any character that could be part of a filemanip- -- GlobPattern.- takeWhile (not . flip elem "[*]\\(|)") $ reverse rMatch-- -- 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 =- let assignPart (ptxt,pidx) =- let matchesParmValue (_, Nothing) = False- matchesParmValue (_, Just vl) = ptxt `elem` vl- in if pidx `elem` rnPartIndices- then- if length rnSplit - pidx < length txtRootSfx- then RootSuffix ptxt- else case L.find matchesParmValue parms of- 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 =- -- pfx parms1 mid parms2 sfx- -- r1-------------------- -- r2------------- -- r3--------- let (pfx,r1) = L.span (not . isRootParNm) rnParts- (parms1,r2) = L.span paramPart r1- (mid,r3) = L.span (not . isRootParNm) r2- (parms2,sfx) = L.span paramPart r3- (_,extraprm) = L.span (not . isRootParNm) sfx- paramPart x = isRootParNm x || isRootSep x- in if null r3- then Just $ Left (pfx, parms1, mid)- else if null extraprm- then Just $ Right (pfx, parms1, mid, parms2, sfx)- else Nothing-- freeFirst Nothing = mzero- freeFirst (Just (Right _)) = mzero- freeFirst (Just (Left (allRP, [], []))) =- -- There were no parameter value matches. If there is- -- a wildcard parameter, try it in all the possible- -- positions.- if length allRP < 3- then mzero- else case freeValueParm of- Nothing -> mzero- Just p ->- do idx <- eachFrom [i | i <- [2..length allRP], even i]- case drop idx allRP of- (RootText idxv:_) -> do- let free = RootParNm (fst p) idxv- start = take (idx - 1) allRP- return ( rpNPM [free]- , rpStr $ start- , rpStr $ drop (idx + 2) allRP )- _ -> mzero- freeFirst (Just (Left (pfx, pl1, sfx))) =- 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))) =- 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- freeMid (Just (Right (pfx, parms1, mid, parms2, sfx))) =- -- If there is a wildcard param and mid is a single- -- element, then try converting the mid to the- -- wildcard, otherwise this is an invalid name.- if length mid /= 3- then mzero- else case freeValueParm of- Nothing -> mzero- Just p ->- case mid of- (ms1:RootText mv:ms2:[]) ->- return ( rpNPM ( parms1 <> [RootParNm (fst p) mv] <>- parms2 )- , rpStr $ pfx <> [ms1]- , rpStr $ ms2 : sfx )- _ -> mzero-- (\(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 :: 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- ])- let l1 = length rootNm- l2 = length pvstr- bslen = l1 - l2- matches n = pvstr `L.isPrefixOf` (drop n rootNm)- case L.find matches $ reverse [1..bslen] of- Just pfxlen ->- 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 :: 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 = origRoot { candidateFile = take i origRootName }- let b = drop i origRootName- if null b- then do return ([], a, "")- else do guard (and [ not $ null b, head b == s ])- return ([], a, tail b)
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 Numeric.Natural import System.FilePath -- ( (</>) ) import qualified System.FilePath.GlobPattern as FPGP #if MIN_VERSION_prettyprinter(1,7,0)@@ -113,6 +114,10 @@ -- 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).+ --+ -- If there is a blank FileSuffix for an associated name, that indicates+ -- that the associated name matches the rootname *without* any suffix (and+ -- implies that the root name has a suffix that can be removed). , associatedNames :: [ (String, FileSuffix) ] -- | The 'validParams' can be used to specify various parameters@@ -158,7 +163,7 @@ -- an explicit blank value). , validParams :: [ParameterPattern] }- deriving (Show, Read)+ deriving Show {-# DEPRECATED inputDir "Use inputDirs instead" #-} @@ -169,8 +174,6 @@ 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@@ -237,16 +240,31 @@ -- 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)+data CandidateFile = CandidateFile+ {+ -- | The 'candidateDir' is the top-level directory path+ -- for this candidate and is usually one of the CUBE+ -- inputDirs+ candidateDir :: FilePath+ -- | The 'candidateSubdirs' is the sequence of+ -- subdirectories beneath the 'candidateDir' where the+ -- 'candidateFile' is located. These subdirectories may+ -- provide parameter matches.+ , candidateSubdirs :: [ FilePath ]+ -- | The 'candidateFile' is the filename portion (only) of+ -- the candidate file. (Use 'candidateToPath' to get the+ -- full filepath from a CandidateFile).+ , candidateFile :: FilePath+ -- | Portions of the candidateFile (or candidateSubdirs)+ -- that match parameters+ , candidatePMatch :: [NamedParamMatch]+ -- | If there are candidatePMatch, this is the index of+ -- the first match. This therefore is also the end of the+ -- "root" file match portion. If no candidatePMatch, this+ -- is the length of the candidateFile.+ , candidateMatchIdx :: Natural+ }+ deriving (Eq, Show) -- Show is for for debugging/tracing -- | Each identified test input set is represented as a 'Sweets'@@ -349,9 +367,13 @@ -- NotSpecified if there are no known 'ParameterPattern' values. data ParamMatch =- -- | This parameter value was explicitly specified in the filename- -- of the expected file.- Explicit String+ -- | This parameter value was not specified in the filename for the+ -- expected file. In addition, the associated 'ParameterPattern'+ -- specified no defined values (i.e. 'Nothing'), so it is not+ -- possible to identify any actual values. Instead, the+ -- 'Expectation' generated for this expected file will supply this+ -- 'NotSpecified' for this type of parameter.+ NotSpecified -- | This parameter value was not specified in the filename of the -- expected file, so the value is being synthetically supplied.@@ -360,13 +382,9 @@ -- value, identifying each as 'Assumed'. | Assumed String - -- | This parameter value was not specified in the filename for the- -- expected file. In addition, the associated 'ParameterPattern'- -- specified no defined values (i.e. 'Nothing'), so it is not- -- possible to identify any actual values. Instead, the- -- 'Expectation' generated for this expected file will supply this- -- 'NotSpecified' for this type of parameter.- | NotSpecified+ -- | This parameter value was explicitly specified in the filename+ -- of the expected file.+ | Explicit String deriving (Show, Eq, Ord) @@ -403,6 +421,17 @@ getParamVal (Explicit v) = Just v getParamVal (Assumed v) = Just v getParamVal _ = Nothing++-- | Returns a value indicating how "strong" a set of ParamMatch values is. This+-- is used to compare between sets of ParamMatches to prefer stronger matches+-- over weaker matches.+matchStrength :: [ParamMatch] -> Natural+matchStrength = \case+ [] -> 0+ (NotSpecified : ps) -> matchStrength ps+ ((Explicit _) : ps) -> 1 + matchStrength ps+ ((Assumed _) : ps) -> 1 + matchStrength ps+ ----------------------------------------------------------------------
tasty-sugar.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: tasty-sugar-version: 1.3.0.2+version: 2.0.0.0 synopsis: Tests defined by Search Using Golden Answer References description: .@@ -87,6 +87,7 @@ library exposed-modules: Test.Tasty.Sugar build-depends: base >=4.10 && < 5+ , containers , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 , filemanip >= 0.3 && < 0.4@@ -109,18 +110,22 @@ library tasty-sugar-internal exposed-modules: Test.Tasty.Sugar.Analysis , Test.Tasty.Sugar.AssocCheck+ , Test.Tasty.Sugar.Candidates , Test.Tasty.Sugar.ExpectCheck+ , Test.Tasty.Sugar.Iterations , Test.Tasty.Sugar.ParamCheck , Test.Tasty.Sugar.Report- , Test.Tasty.Sugar.RootCheck , Test.Tasty.Sugar.Types build-depends: base >= 4.10+ , containers >= 0.6 && < 0.7+ , directory , filepath , filemanip , kvitable >= 1.0 && < 1.1 , logict , microlens >= 0.4 && < 0.5 , mtl >= 2.2 && < 2.3+ , parallel >= 3.2 && < 3.3 , prettyprinter >= 1.7 && < 1.8 , text >= 1.2 && < 1.3 hs-source-dirs: src/internal@@ -136,6 +141,7 @@ hs-source-dirs: test default-language: Haskell2010 GHC-options: -fhide-source-paths+ -threaded -with-rtsopts=-N main-is: TestMain.hs other-modules: TestMultiAssoc TestNoAssoc@@ -165,6 +171,7 @@ hs-source-dirs: examples/example1 default-language: Haskell2010 GHC-options: -fhide-source-paths+ -threaded -with-rtsopts=-N main-is: test-passthru-ascii.hs other-modules: NiftyText build-depends: base@@ -177,6 +184,7 @@ hs-source-dirs: examples/params default-language: Haskell2010 GHC-options: -fhide-source-paths+ -threaded -with-rtsopts=-N main-is: test-params.hs build-depends: base , pretty-show@@ -189,6 +197,7 @@ hs-source-dirs: test/internals default-language: Haskell2010 GHC-options: -fhide-source-paths+ -threaded -with-rtsopts=-N main-is: test-internals.hs build-depends: base , pretty-show
test/Sample1.hs view
@@ -9,12 +9,9 @@ import Text.RawString.QQ -sample1 :: FilePath -> [CandidateFile]-sample1 testInpPath =- fmap (\f -> CandidateFile { candidateDir = testInpPath- , candidateSubdirs = []- , candidateFile = f })-+sample1 :: CUBE -> FilePath -> [CandidateFile]+sample1 cube testInpPath =+ fmap (makeCandidate cube testInpPath []) $ filter (not . null) $ lines [r| global-max-good.c
test/TestFileSys.hs view
@@ -1,1115 +1,663 @@ 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 = [ ]- }+import Data.Either ( lefts, rights )+import qualified Data.List as L+import Data.Maybe ( isJust )+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+ cands <- findCandidates sugarCube1 testInpPath+ -- putStrLn $ ppShow sweets+ let chkCandidate = checkCandidate sugarCube1 (const $ rights cands)+ testInpPath [] 0+ let exp0 f d l o = Expectation+ { expectedFile = testInpPath </> f+ , expParamsMatch = [ ("debug", d) , ("llvm", l) , ("opt", o)]+ , associated = [ ("source", testInpPath </> "foo.c") ]+ }+ let exp f d l o = exp0 f (Assumed d) (Explicit l) o+ testExp s i f d l o = testCase ("Exp #" <> show i)+ $ safeElem i (expected s) @?= Just (exp f d l o)+ return+ [ TT.testGroup "Cube 1"+ [ testCase "correct # of sweets" $ 3 @=? length sweets++ , testCase "correct # of candidate warnings" $ 0 @=? length (lefts cands)+ , testCase "correct # of candidate files" $ 11 @=? length (rights cands)+ , TT.testGroup "Candidates"+ [+ chkCandidate "bar.exe" []+ , chkCandidate "cow.O2.exp" [("opt", Explicit "O2")]+ , chkCandidate "cow.c" []+ , chkCandidate "foo.c" []+ , chkCandidate "foo.exp" []+ , chkCandidate "foo.llvm10-O2-exp" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")]+ , chkCandidate "foo.llvm10.O2.exe" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")]+ , chkCandidate "foo.llvm13.exe" [("llvm", Explicit "llvm13")]+ , chkCandidate "foo.llvm199.exp" [("opt", Explicit "llvm199")]+ , chkCandidate "foo.llvm9.exe" [("llvm", Explicit "llvm9")]+ , chkCandidate "foo.llvm9.exp" [("llvm", Explicit "llvm9")]+ ]++ , TT.testGroup "Sweet #1" $+ let sweet = head sweets in+ let tE n e d o = testExp sweet n e d "llvm10" o in+ [+ testCase "root match" $ "foo.llvm10.O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm10.O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , tE 3 "foo.llvm10-O2-exp" "no" (Explicit "O2")+ , tE 2 "foo.llvm10-O2-exp" "yes" (Explicit "O2")+ , tE 1 "foo.llvm10-O2-exp" "no" NotSpecified+ , tE 0 "foo.llvm10-O2-exp" "yes" NotSpecified+ , tE 5 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , tE 4 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ ]+ , 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" $ 4 @=? length (expected sweet)+ , testExp sweet 1 "foo.exp" "no" "llvm13" NotSpecified+ , testExp sweet 0 "foo.exp" "yes" "llvm13" NotSpecified+ -- llvm199 is not a registered value for the "llvm" parameter, so it+ -- can match the "opt" parameter as an alternate expectation match.+ , testExp sweet 3 "foo.llvm199.exp" "no" "llvm13" (Explicit "llvm199")+ , testExp sweet 2 "foo.llvm199.exp" "yes" "llvm13" (Explicit "llvm199")+ ]+ , 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" $ 4 @=? length (expected sweet)+ -- llvm199 is not a registered value for the "llvm" parameter, so it+ -- can match the "opt" parameter as an alternate expectation match.+ , testExp sweet 1 "foo.llvm199.exp" "no" "llvm9" (Explicit "llvm199")+ , testExp sweet 0 "foo.llvm199.exp" "yes" "llvm9" (Explicit "llvm199")+ , testExp sweet 3 "foo.llvm9.exp" "no" "llvm9" NotSpecified+ , testExp sweet 2 "foo.llvm9.exp" "yes" "llvm9" NotSpecified+ ]+ ]+ ]+++fsTests2 :: IO [TT.TestTree]+fsTests2 = do+ sweets <- findSugar sugarCube2+ -- putStrLn $ ppShow sweets+ cands <- concat <$> mapM (findCandidates sugarCube2) (inputDirs sugarCube2)+ let warns = lefts cands+ -- putStrLn $ ppShow sweets+ let chkCand d = checkCandidate sugarCube2 (const $ rights cands) d [] 0+ let chkCandidate1 = chkCand testInpPath+ let chkCandidate2 = chkCand testInpPath2+ let exp p sf f d l o = Expectation+ { expectedFile = p </> f+ , expParamsMatch = [ ("debug", Assumed d)+ , ("llvm", l)+ , ("opt", o)+ ]+ , associated = [ ("source", testInpPath </> sf) ]+ }+ testExp s sf i f d l o =+ testCase ("Exp #" <> show i)+ $ safeElem i (expected s) @?= Just (exp testInpPath sf f d l o)+ return+ [ TT.testGroup "Cube 2"+ [ testCase "correct # of sweets" $ 5 @=? length sweets++ , testCase "correct # of candidate warnings" $ 2 @=? length warns+ , testCase "Warn about foo/baz"+ $ isJust (L.find ("]foo/baz does not exist" `L.isSuffixOf`) warns)+ @? ("foo/baz warning missing in " <> show warns)+ , testCase "Warn about /foo/bar"+ $ "/foo/bar does not exist" `elem` warns+ @? ("/foo/bar warning missing in " <> show warns)+ , testCase "correct # of candidate files" $ 14 @=? length (rights cands)+ , TT.testGroup "Candidates"+ [+ chkCandidate1 "bar.exe" []+ , chkCandidate1 "cow.O2.exp" [("opt", Explicit "O2")]+ , chkCandidate1 "cow.c" []+ , chkCandidate1 "foo.c" []+ , chkCandidate1 "foo.exp" []+ , chkCandidate1 "foo.llvm10-O2-exp" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")]+ , chkCandidate1 "foo.llvm10.O2.exe" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")]+ , chkCandidate1 "foo.llvm13.exe" [("llvm", Explicit "llvm13")]+ , chkCandidate1 "foo.llvm199.exp" [("opt", Explicit "llvm199")]+ , chkCandidate1 "foo.llvm9.exe" [("llvm", Explicit "llvm9")]+ , chkCandidate1 "foo.llvm9.exp" [("llvm", Explicit "llvm9")]+ , chkCandidate2 "cow-O2.exe" [("opt", Explicit "O2")]+ , chkCandidate2 "foo-llvm13.exp" [("llvm", Explicit "llvm13")]+ , chkCandidate2 "foo.O1-llvm10.exe" [("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")]+ ]++ , TT.testGroup "Sweet #1" $+ let sweet = head sweets in+ let testExp' n d l = testExp sweet "cow.c" n "cow.O2.exp" d+ (Assumed l) (Explicit "O2")+ in+ [+ testCase "root match" $ "cow-O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "cow-O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testExp' 5 "no" "llvm10"+ , testExp' 4 "no" "llvm13"+ , testExp' 3 "no" "llvm9"+ , testExp' 2 "yes" "llvm10"+ , testExp' 1 "yes" "llvm13"+ , testExp' 0 "yes" "llvm9"+ ]+ , TT.testGroup "Sweet #2" $+ let sweet = head $ drop 1 sweets in+ let testExp' n e d o = testExp sweet "foo.c" n e d (Explicit "llvm10") o+ in+ [+ testCase "root match" $ "foo.O1-llvm10.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath2 </> "foo.O1-llvm10.exe" @=? rootFile sweet+ , testCase "# expectations" $ 8 @=? length (expected sweet)+ , testExp' 1 "foo.exp" "no" (Explicit "O1")+ , testExp' 0 "foo.exp" "yes" (Explicit "O1")+ , testExp' 5 "foo.llvm10-O2-exp" "no" (Explicit "O2")+ , testExp' 4 "foo.llvm10-O2-exp" "no" NotSpecified+ , testExp' 3 "foo.llvm10-O2-exp" "yes" (Explicit "O2")+ , testExp' 2 "foo.llvm10-O2-exp" "yes" NotSpecified+ , testExp' 7 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , testExp' 6 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ ]+ , TT.testGroup "Sweet #3" $+ let sweet = head $ drop 2 sweets in+ let testExp' n e d o = testExp sweet "foo.c" n e d (Explicit "llvm10") o+ in+ [+ testCase "root match" $ "foo.llvm10.O2.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm10.O2.exe" @=? rootFile sweet+ , testCase "# expectations" $ 6 @=? length (expected sweet)+ , testExp' 3 "foo.llvm10-O2-exp" "no" (Explicit "O2")+ , testExp' 2 "foo.llvm10-O2-exp" "yes" (Explicit "O2")+ , testExp' 1 "foo.llvm10-O2-exp" "no" NotSpecified+ , testExp' 0 "foo.llvm10-O2-exp" "yes" NotSpecified+ , testExp' 5 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , testExp' 4 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ ]+ , TT.testGroup "Sweet #4" $+ let sweet = head $ drop 3 sweets in+ let testExp' s n e d o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp s "foo.c" e d (Explicit "llvm13") o)+ testExp1 = testExp' testInpPath2+ testExp2 = testExp' testInpPath+ in+ [+ testCase "root match" $ "foo.llvm13.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm13.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testExp1 1 "foo-llvm13.exp" "no" NotSpecified+ , testExp1 0 "foo-llvm13.exp" "yes" NotSpecified+ , testExp2 3 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , testExp2 2 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ ]+ , TT.testGroup "Sweet #5" $+ let sweet = head $ drop 4 sweets in+ let testExp' n e d o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp testInpPath "foo.c" e d (Explicit "llvm9") o)+ in+ [+ testCase "root match" $ "foo.llvm9.exe" @=? rootMatchName sweet+ , testCase "root file" $ testInpPath </> "foo.llvm9.exe" @=? rootFile sweet+ , testCase "# expectations" $ 4 @=? length (expected sweet)+ , testExp' 1 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , testExp' 0 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ , testExp' 3 "foo.llvm9.exp" "no" NotSpecified+ , testExp' 2 "foo.llvm9.exp" "yes" NotSpecified+ ]+ ]+ ]++fsTests3 :: IO [TT.TestTree]+fsTests3 = do+ sweets <- findSugar sugarCube3+ -- putStrLn $ ppShow sweets+ cands <- concat <$> mapM (findCandidates sugarCube3) (inputDirs sugarCube3)+ let warns = lefts cands+ let chkCand t s = checkCandidate sugarCube3 (const $ rights cands) t s 0+ let chkCandidate1 = chkCand testInpPath []+ let chkCandidate2 = chkCand testInpPath2 []+ let tbDir = "test/builds"+ let exp0 p sf f d l o = Expectation+ { expectedFile = p </> f+ , expParamsMatch = [ ("debug", d) , ("llvm", l) , ("opt", o)]+ , associated = [ ("source", testInpPath </> sf) ]+ }+ let exp p sf f d l o = exp0 p sf f (Assumed d) l o+ testExp s sf i f d l o =+ testCase ("Exp #" <> show i)+ $ safeElem i (expected s) @?= Just (exp testInpPath sf f d l o)+ return+ [ TT.testGroup "Cube 3"+ [ testCase "correct # of sweets" $ 12 @=? length sweets++ , testCase "correct # of candidate warnings" $ 1 @=? length warns+ , testCase "Warn about foo/baz"+ $ isJust (L.find ("]foo/baz does not exist" `L.isSuffixOf`) warns)+ @? ("foo/baz warning missing in " <> show warns)+ , testCase "correct # of candidate files" $ 29 @=? length (rights cands)+ , TT.testGroup "Candidates"+ [+ chkCandidate1 "bar.exe" []+ , chkCandidate1 "cow.O2.exp" [("opt", Explicit "O2")]+ , chkCandidate1 "cow.c" []+ , chkCandidate1 "foo.c" []+ , chkCandidate1 "foo.exp" []+ , chkCandidate1 "foo.llvm10-O2-exp" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")+ ]+ , chkCandidate1 "foo.llvm10.O2.exe" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "O2")+ ]+ , chkCandidate1 "foo.llvm13.exe" [("llvm", Explicit "llvm13")]+ , chkCandidate1 "foo.llvm199.exp" [("opt", Explicit "llvm199")]+ , chkCandidate1 "foo.llvm9.exe" [("llvm", Explicit "llvm9")]+ , chkCandidate1 "foo.llvm9.exp" [("llvm", Explicit "llvm9")]+ , chkCandidate2 "cow-O2.exe" [("opt", Explicit "O2")]+ , chkCandidate2 "foo-llvm13.exp" [("llvm", Explicit "llvm13")]+ , chkCandidate2 "foo.O1-llvm10.exe" [("llvm", Explicit "llvm10")+ , ("opt", Explicit "O1")+ ]+ , chkCand tbDir ["O0"] "cow-llvm13.exp" [("llvm", Explicit "llvm13")+ ,("opt", Explicit "O0")+ ]+ , chkCand tbDir ["O0"] "cow.exe" [("opt", Explicit "O0")]+ , chkCand tbDir ["O0"] "cow.exp" [("opt", Explicit "O0")]+ , chkCand tbDir ["O0", "llvm9"] "cow.exe" [("llvm", Explicit "llvm9")+ ,("opt", Explicit "O0")+ ]+ , chkCand tbDir ["O0", "llvm9"] "cow.lnk" [("llvm", Explicit "llvm9")+ ,("opt", Explicit "O0")+ ]+ , chkCand tbDir [] "cow.exp" []+ , chkCand tbDir ["gen", "llvm10"] "frog.exe" [("llvm", Explicit "llvm10")+ ,("opt", Explicit "gen")+ ]+ , chkCand tbDir ["gen", "llvm13"] "frog.exe" [("llvm", Explicit "llvm13")+ ,("opt", Explicit "gen")+ ]+ , chkCand tbDir ["gen", "llvm9"] "frog.exe" [("llvm", Explicit "llvm9")+ ,("opt", Explicit "gen")+ ]+ , chkCand tbDir ["llvm10"] "foo.exp" [("llvm", Explicit "llvm10")]+ , chkCand tbDir ["llvm13"] "cow.exe" [("llvm", Explicit "llvm13")]+ , chkCand tbDir ["llvm13", "opts", "O3"] "cow.exe"+ [("llvm", Explicit "llvm13")+ ,("opt", Explicit "O3")+ ,("opt", Explicit "opts")+ ]+ , chkCand tbDir ["want"] "frog-llvm9-no.exp" [("debug", Explicit "no")+ ,("llvm", Explicit "llvm9")+ ,("opt", Explicit "want")+ ]+ , chkCand tbDir ["want"] "frog-no.exp" [("debug", Explicit "no")+ ,("opt", Explicit "want")+ ]+ , chkCand tbDir ["want"] "frog-yes.exp" [("debug", Explicit "yes")+ ,("opt", Explicit "want")+ ]+ ]++ , let sweetNum = 8+ sweet = head $ drop (sweetNum - 1) sweets+ testExp' n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp testInpPath "cow.c" e d (Assumed l) o)+ 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)+ , testExp' 5 "cow.O2.exp" "no" "llvm10" (Explicit "O2")+ , testExp' 4 "cow.O2.exp" "no" "llvm13" (Explicit "O2")+ , testExp' 3 "cow.O2.exp" "no" "llvm9" (Explicit "O2")+ , testExp' 2 "cow.O2.exp" "yes" "llvm10" (Explicit "O2")+ , testExp' 1 "cow.O2.exp" "yes" "llvm13" (Explicit "O2")+ , testExp' 0 "cow.O2.exp" "yes" "llvm9" (Explicit "O2")+ ]+++ , let sweetNum = 6+ sweet = head $ drop (sweetNum - 1) sweets+ testExp' s n e d o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp s "cow.c" e d (Explicit "llvm13") o)+ testExp1 = testExp' testInpPath+ testExp3 = testExp' (takeDirectory testInpPath3)+ 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" $ 6 @=? length (expected sweet)+ , testExp3 3 "O0/cow-llvm13.exp" "no" (Explicit "O0")+ , testExp3 2 "O0/cow-llvm13.exp" "no" NotSpecified+ , testExp3 1 "O0/cow-llvm13.exp" "yes" (Explicit "O0")+ , testExp3 0 "O0/cow-llvm13.exp" "yes" NotSpecified+ , testExp1 5 "cow.O2.exp" "no" (Explicit "O2")+ , testExp1 4 "cow.O2.exp" "yes" (Explicit "O2")+ ]++ , let sweetNum = 7+ sweet = head $ drop (sweetNum - 1) sweets+ testExp' s n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp s "cow.c" e d (Explicit l) o)+ tE1 = testExp' testInpPath+ tE3 = testExp' (takeDirectory testInpPath3)+ 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" $ 10 @=? length (expected sweet)+ , tE3 3 "O0/cow-llvm13.exp" "no" "llvm13" (Explicit "O0")+ , tE3 1 "O0/cow-llvm13.exp" "yes" "llvm13" (Explicit "O0")+ , tE3 7 "cow.exp" "no" "llvm13" (Explicit "O3")+ , tE3 6 "cow.exp" "no" "llvm13" (Explicit "opts")+ , tE3 5 "cow.exp" "yes" "llvm13" (Explicit "O3")+ , tE3 4 "cow.exp" "yes" "llvm13" (Explicit "opts")+ , tE1 9 "cow.O2.exp" "no" "llvm13" (Explicit "O2")+ , tE1 8 "cow.O2.exp" "yes" "llvm13" (Explicit "O2")+ -- n.b. O0/cow-llvm13.exp is longer than cow.exp, so it is the+ -- preferred expected file for the following two entries:+ , tE3 2 "O0/cow-llvm13.exp" "no" "llvm13" NotSpecified+ , tE3 0 "O0/cow-llvm13.exp" "yes" "llvm13" NotSpecified+ ]++ , let sweetNum = 1+ sweet = head $ drop (sweetNum - 1) sweets+ exp' n = head $ drop (n-1) $ expected sweet+ tE1 n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp (takeDirectory testInpPath3) "cow.c" e d l o)+ tE2 n e d l o =+ let lda = ("ld-config"+ , takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ ex = exp (takeDirectory testInpPath3) "cow.c" e d l o+ in testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (ex { associated = lda : associated ex })+ 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" $ 6 @=? length (expected sweet)+ , tE1 1 "O0/cow-llvm13.exp" "no" (Explicit "llvm13") (Explicit "O0")+ , tE1 0 "O0/cow-llvm13.exp" "yes" (Explicit "llvm13") (Explicit "O0")+ , tE1 5 "O0/cow.exp" "no" (Assumed "llvm10") (Explicit "O0")+ , tE2 4 "O0/cow.exp" "no" (Assumed "llvm9") (Explicit "O0")+ , tE1 3 "O0/cow.exp" "yes" (Assumed "llvm10") (Explicit "O0")+ , tE2 2 "O0/cow.exp" "yes" (Assumed "llvm9") (Explicit "O0")+ ]++ , let sweetNum = 2+ sweet = head $ drop (sweetNum - 1) sweets+ tExp' s lda n e d l o =+ let ex = exp s "cow.c" e d (Explicit l) o+ in testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (ex { associated = lda <> associated ex })+ tExp1 = tExp' testInpPath []+ tExp3 = tExp' (takeDirectory testInpPath3)+ [ ("ld-config"+ , takeDirectory testInpPath3 </> "O0/llvm9/cow.lnk")+ ]+ 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" $ 6 @=? length (expected sweet)+ , tExp3 1 "O0/cow.exp" "no" "llvm9" (Explicit "O0")+ , tExp3 0 "O0/cow.exp" "yes" "llvm9" (Explicit "O0")+ , tExp3 3 "cow.exp" "no" "llvm9" NotSpecified+ , tExp3 2 "cow.exp" "yes" "llvm9" NotSpecified+ , tExp1 5 "cow.O2.exp" "no" "llvm9" (Explicit "O2")+ , tExp1 4 "cow.O2.exp" "yes" "llvm9" (Explicit "O2")+ ]++ , let sweetNum = 9+ sweet = head $ drop (sweetNum - 1) sweets+ tE' s n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp s "foo.c" e d (Explicit l) o)+ tE1 = tE' testInpPath+ tE3 = tE' (takeDirectory testInpPath3)+ 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" $ 8 @=? length (expected sweet)+ , tE3 1 "llvm10/foo.exp" "no" "llvm10" (Explicit "O1")+ , tE3 0 "llvm10/foo.exp" "yes" "llvm10" (Explicit "O1")+ , tE1 5 "foo.llvm10-O2-exp" "no" "llvm10" (Explicit "O2")+ , tE1 3 "foo.llvm10-O2-exp" "yes" "llvm10" (Explicit "O2")+ -- n.b. foo.llvm10-O2-exp is longer than llvm10/foo.exp, so it is the+ -- preferred expected file for the following two expected entries+ , tE1 4 "foo.llvm10-O2-exp" "no" "llvm10" NotSpecified+ , tE1 2 "foo.llvm10-O2-exp" "yes" "llvm10" NotSpecified+ , tE1 7 "foo.llvm199.exp" "no" "llvm10" (Explicit "llvm199")+ , tE1 6 "foo.llvm199.exp" "yes" "llvm10" (Explicit "llvm199")+ ]++ , let sweetNum = 10+ sweet = head $ drop (sweetNum - 1) sweets+ tE1 n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp testInpPath "foo.c" e d (Explicit l) o)+ tE3 n e d l o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp (takeDirectory testInpPath3) "foo.c" e d (Explicit l) o)+ 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" $ 6 @=? length (expected sweet)+ , tE1 3 "foo.llvm10-O2-exp" "no" "llvm10" (Explicit "O2")+ , tE1 2 "foo.llvm10-O2-exp" "yes" "llvm10" (Explicit "O2")+ , tE1 5 "foo.llvm199.exp" "no" "llvm10" (Explicit "llvm199")+ , tE1 4 "foo.llvm199.exp" "yes" "llvm10" (Explicit "llvm199")+ -- n.b. foo.llvm10-O2-exp is longer than llvm10/foo.exp so it is the+ -- preferred expected file for the following two entries:+ , tE1 1 "foo.llvm10-O2-exp" "no" "llvm10" NotSpecified+ , tE1 0 "foo.llvm10-O2-exp" "yes" "llvm10" NotSpecified+ ]++ , let sweetNum = 11+ sweet = head $ drop (sweetNum - 1) sweets+ tE' s n e d o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp s "foo.c" e d (Explicit "llvm13") o)+ tE1 = tE' testInpPath+ tE2 = tE' testInpPath2+ 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" $ 4 @=? length (expected sweet)+ , tE2 1 "foo-llvm13.exp" "no" NotSpecified+ , tE2 0 "foo-llvm13.exp" "yes" NotSpecified+ , tE1 3 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , tE1 2 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ ]++ , let sweetNum = 12+ sweet = head $ drop (sweetNum - 1) sweets+ tE1 n e d o =+ testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (exp testInpPath "foo.c" e d (Explicit "llvm9") o)+ 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" $ 4 @=? length (expected sweet)+ , tE1 1 "foo.llvm199.exp" "no" (Explicit "llvm199")+ , tE1 0 "foo.llvm199.exp" "yes" (Explicit "llvm199")+ , tE1 3 "foo.llvm9.exp" "no" NotSpecified+ , tE1 2 "foo.llvm9.exp" "yes" NotSpecified+ ]++ , let sweetNum = 5+ sweet = head $ drop (sweetNum - 1) sweets+ tE1 n e d o =+ let ex = exp0 (takeDirectory testInpPath3) "foo.c" e d (Explicit "llvm9") o+ in testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (ex { associated = [] })+ 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" $ 4 @=? length (expected sweet)+ , tE1 1 "want/frog-llvm9-no.exp" (Explicit "no") (Explicit "want")+ , tE1 0 "want/frog-llvm9-no.exp" (Explicit "no") NotSpecified+ , tE1 3 "want/frog-yes.exp" (Explicit "yes") (Explicit "want")+ , tE1 2 "want/frog-yes.exp" (Explicit "yes") NotSpecified+ -- TODO not using dir elements from root for unconstrained params+ -- , tE1 2 "want/frog-llvm9-no.exp" (Explicit "no") (Explicit "gen")+ -- , tE1 4 "want/frog-yes.exp" (Explicit "yes") (Explicit "gen")+ ]++ , let sweetNum = 3+ sweet = head $ drop (sweetNum - 1) sweets+ tE1 n e d o =+ let ex = exp0 (takeDirectory testInpPath3) "foo.c" e d (Explicit "llvm10") o+ in testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (ex { associated = [] })+ 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" $ 4 @=? length (expected sweet)+ , tE1 1 "want/frog-no.exp" (Explicit "no") (Explicit "want")+ , tE1 0 "want/frog-no.exp" (Explicit "no") NotSpecified+ , tE1 3 "want/frog-yes.exp" (Explicit "yes") (Explicit "want")+ , tE1 2 "want/frog-yes.exp" (Explicit "yes") NotSpecified+ -- TODO not using dir elements from root for unconstrained params+ -- , tE1 4 "want/frog-yes.exp" (Explicit "yes") (Explicit "gen")+ -- , tE1 2 "want/frog-no.exp" (Explicit "no") (Explicit "gen")+ ]++ , let sweetNum = 4+ sweet = head $ drop (sweetNum - 1) sweets+ tE1 n e d o =+ let ex = exp0 (takeDirectory testInpPath3) "foo.c" e d (Explicit "llvm13") o+ in testCase ("Exp #" <> show n)+ $ safeElem n (expected sweet)+ @?= Just (ex { associated = [] })+ 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" $ 4 @=? length (expected sweet)+ , tE1 1 "want/frog-no.exp" (Explicit "no") (Explicit "want")+ , tE1 0 "want/frog-no.exp" (Explicit "no") NotSpecified+ , tE1 3 "want/frog-yes.exp" (Explicit "yes") (Explicit "want")+ , tE1 2 "want/frog-yes.exp" (Explicit "yes") NotSpecified+ -- TODO not using dir elements from root for unconstrained params+ -- , tE1 2 "want/frog-no.exp" (Explicit "no") (Explicit "gen")+ -- , tE1 4 "want/frog-yes.exp" (Explicit "yes") (Explicit "gen") ] , testCase "correct # of foo sweets" $ 4 @=?
test/TestGCD.hs view
@@ -11,7 +11,9 @@ import TestUtils import Text.RawString.QQ +import Prelude hiding ( exp ) + testInpPath = "test-data/samples" testParams = [ ("solver", Just ["z3", "yices", "boolector", "cvc4"])@@ -31,8 +33,8 @@ gcdSampleTests :: [TT.TestTree] gcdSampleTests =- let (sugar,sdesc) = findSugarIn sugarCube gcdSamples- in [ testCase "valid sample" $ 19 @=? length gcdSamples+ let (sugar,sdesc) = findSugarIn sugarCube (gcdSamples sugarCube)+ in [ testCase "valid sample" $ 19 @=? length (gcdSamples sugarCube) , sugarTestEq "correct found count" sugarCube gcdSamples 1 length , testCase "sweets rendering" $@@ -53,90 +55,54 @@ , testCase "Expectations" $ compareBags "expected" (expected $ head sugar) $ let p = (testInpPath </>) in+ let exp e s l c o =+ Expectation+ { expectedFile = p e+ , expParamsMatch = [("solver", s), ("loop-merging", l)]+ , associated = [ ("config", p c), ("stdio", p o)]+ }+ e = Explicit+ a = Assumed+ in [- Expectation- { expectedFile = p "gcd-test.boolector.good"- , expParamsMatch = [ ("solver", Explicit "boolector")- , ("loop-merging", Assumed "loopmerge")- ]- , associated = [ ("config", p "gcd-test.loopmerge.config")- , ("stdio", p "gcd-test.boolector.print")- ]- }- , Expectation- { expectedFile = p "gcd-test.boolector.good"- , expParamsMatch = [ ("solver", Explicit "boolector")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("config", p "gcd-test.config")- , ("stdio", p "gcd-test.boolector.print")- ]- }+ exp "gcd-test.boolector.good" (e "boolector") (a "loopmerge")+ "gcd-test.loopmerge.config"+ "gcd-test.boolector.print" - , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "cvc4")- , ("loop-merging", Assumed "loopmerge")- ]- , associated = [ ("config", p "gcd-test.loopmerge.config")- , ("stdio", p "gcd-test.print")- ]- }- , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "cvc4")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("config", p "gcd-test.config")- , ("stdio", p "gcd-test.print")- ]- }+ , exp "gcd-test.boolector.good" (e "boolector") (a "loop")+ "gcd-test.config"+ "gcd-test.boolector.print" - , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "yices")- , ("loop-merging", Assumed "loopmerge")- ]- , associated = [ ("config", p "gcd-test.loopmerge.config")- , ("stdio", p "gcd-test.print")- ]- }- , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "yices")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("config", p "gcd-test.config")- , ("stdio", p "gcd-test.print")- ]- }+ , exp "gcd-test.good" (a "cvc4") (a "loopmerge")+ "gcd-test.loopmerge.config"+ "gcd-test.print" - , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "z3")- , ("loop-merging", Assumed "loopmerge")- ]- , associated = [ ("config", p "gcd-test.loopmerge.config")- , ("stdio", p "gcd-test.print")- ]- }- , Expectation- { expectedFile = p "gcd-test.good"- , expParamsMatch = [ ("solver", Assumed "z3")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("config", p "gcd-test.config")- , ("stdio", p "gcd-test.print")- ]- }+ , exp "gcd-test.good" (a "cvc4") (a "loop")+ "gcd-test.config"+ "gcd-test.print"++ , exp "gcd-test.good" (a "yices") (a "loopmerge")+ "gcd-test.loopmerge.config"+ "gcd-test.print"++ , exp "gcd-test.good" (a "yices") (a "loop")+ "gcd-test.config"+ "gcd-test.print"++ , exp "gcd-test.good" (a "z3") (a "loopmerge")+ "gcd-test.loopmerge.config"+ "gcd-test.print"++ , exp "gcd-test.good" (a "z3") (a "loop")+ "gcd-test.config"+ "gcd-test.print"+ ] ] -gcdSamples = fmap (\f -> CandidateFile { candidateDir = testInpPath- , candidateSubdirs = []- , candidateFile = f })- $ filter (not . null)- $ lines [r|+gcdSamples cube = fmap (makeCandidate cube testInpPath [])+ $ filter (not . null)+ $ lines [r| gcd-test.boolector.boolector.out gcd-test.boolector.boolector.print.out gcd-test.boolector.good
test/TestMultiAssoc.hs view
@@ -35,12 +35,12 @@ multiAssocTests :: [TT.TestTree] multiAssocTests =- let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 testInpPath)+ let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 sugarCube 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" $ 57 @=? length (sample1 testInpPath)+ testCase "valid sample" $ 57 @=? length (sample1 sugarCube testInpPath) -- KWQ: disabled 28 June 2022: encounters a pathological case in kvitable -- rendering that causes this test to run ... forever (?)@@ -51,10 +51,31 @@ -- putStrLn $ T.unpack actual -- T.length actual > 0 @? "change this to see the table" - , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length+ , sugarTestEq "correct found count" sugarCube+ (flip sample1 testInpPath) 6 length , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in+ let exp0 e a f s =+ Expectation { expectedFile = p e+ , expParamsMatch = [("arch", a), ("form", f)]+ , associated = s+ }+ exp1 e a f x =+ let e1 = exp0 e a f []+ in e1 { associated = ("exe", p x) : associated e1 }+ exp2 e a f x o =+ let e1 = exp1 e a f x+ in e1 { associated = ("obj", p o) : associated e1 }+ exp2i e a f x i =+ let e1 = exp1 e a f x+ in e1 { associated = ("include", p i) : associated e1 }+ exp3 e a f x o i =+ let e1 = exp2 e a f x o+ in e1 { associated = ("include", p i) : associated e1 }+ e = Explicit+ a = Assumed+ in [ Sweets { rootMatchName = "global-max-good.c" , rootBaseName = "global-max-good"@@ -62,36 +83,19 @@ , cubeParams = validParams sugarCube , expected = [- Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "base")]- , associated = [ ("exe", p "global-max-good.ppc.exe")- , ("obj", p "global-max-good.ppc.o")- ]- }- , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "refined")]- , associated = [ ("exe", p "global-max-good.ppc.exe")- , ("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")- ]- }+ exp2 "global-max-good.ppc.expected" (e "ppc") (a "refined")+ "global-max-good.ppc.exe"+ "global-max-good.ppc.o"++ , exp2 "global-max-good.ppc.expected" (e "ppc") (a "base")+ "global-max-good.ppc.exe"+ "global-max-good.ppc.o"++ , exp1 "global-max-good.x86.expected" (e "x86") (a "refined")+ "global-max-good.x86.exe"++ , exp1 "global-max-good.x86.expected" (e "x86") (a "base")+ "global-max-good.x86.exe" ] } @@ -100,42 +104,23 @@ , rootFile = p "jumpfar.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "jumpfar.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "base") ]- , associated = [ ("exe", p "jumpfar.ppc.exe")- , ("include", p "jumpfar.h")- -- The x86 versions should not match this- , ("obj", p "jumpfar.ppc.o")- ]- }- , Expectation- { expectedFile = p "jumpfar.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , associated = [ ("exe", p "jumpfar.ppc.exe")- , ("include", p "jumpfar.h")- -- The x86 versions should not match this- , ("obj", p "jumpfar.ppc.o")- ]- }- , 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")- ]- }+ [ exp3 "jumpfar.ppc.expected" (e "ppc") (a "refined")+ "jumpfar.ppc.exe"+ "jumpfar.ppc.o"+ "jumpfar.h"++ , exp3 "jumpfar.ppc.expected" (e "ppc") (a "base")+ "jumpfar.ppc.exe"+ "jumpfar.ppc.o"+ "jumpfar.h"++ , exp2i "jumpfar.x86.expected" (e "x86") (a "refined")+ "jumpfar.x86.exe"+ "jumpfar.h"++ , exp2i "jumpfar.x86.expected" (e "x86") (a "base")+ "jumpfar.x86.exe"+ "jumpfar.h" ] } , Sweets { rootMatchName = "looping.c"@@ -143,34 +128,17 @@ , rootFile = p "looping.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "looping.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "base") ]- , associated = [ ("exe", p "looping.ppc.exe")- ]- }- , Expectation- { expectedFile = p "looping.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , 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")- ]- }+ [ exp1 "looping.ppc.expected" (e "ppc") (a "refined")+ "looping.ppc.exe"++ , exp1 "looping.ppc.expected" (e "ppc") (a "base")+ "looping.ppc.exe"++ , exp1 "looping.x86.expected" (e "x86") (a "refined")+ "looping.x86.exe"++ , exp1 "looping.x86.expected" (e "x86") (a "base")+ "looping.x86.exe" ] } , Sweets { rootMatchName = "looping-around.c"@@ -178,34 +146,17 @@ , 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-around.ppc.exe")- ]- }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , 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")- ]- }+ [ exp1 "looping-around.expected" (a "x86") (a "refined")+ "looping-around.x86.exe"++ , exp1 "looping-around.expected" (a "x86") (a "base")+ "looping-around.x86.exe"++ , exp1 "looping-around.ppc.expected" (e "ppc") (a "refined")+ "looping-around.ppc.exe"++ , exp1 "looping-around.ppc.expected" (e "ppc") (a "base")+ "looping-around.ppc.exe" ] } , Sweets { rootMatchName = "switching.c"@@ -213,46 +164,32 @@ , rootFile = p "switching.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "switching.ppc.base-expected"- , expParamsMatch = [ ("form", Explicit "base")- , ("arch", Explicit "ppc")- ]- , associated = [ ("exe", p "switching.ppc.exe")- -- Note: uses switching.ppc.base.o- -- and not switching.ppc.o--or- -- both--because the former is a- -- more explicit match against the- -- expParamsMatch.- , ("obj", p "switching.ppc.base.o")- , ("include", p "switching.h")- , ("c++-include", p "switching.hh")- , ("plain", p "switching")- ]- }- , 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")- ]- , associated = [ ("exe", p "switching.x86.exe")- , ("obj", p "switching-refined.x86.o")- , ("include", p "switching.h")- , ("c++-include", p "switching.hh")- , ("plain", p "switching")- ]- }+ [ exp0 "switching.ppc.base-expected" (e "ppc") (e "base")+ [ ("exe", p "switching.ppc.exe")+ -- Note: uses switching.ppc.base.o and not+ -- switching.ppc.o--or both--because the former is a more+ -- explicit match against the expParamsMatch.+ , ("obj", p "switching.ppc.base.o")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]++ , exp0 "switching.x86.base-expected" (e "x86") (e "base")+ [ ("exe", p "switching.x86.exe")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]++ , exp0 "switching.x86.refined-expected" (e "x86") (e "refined")+ [ ("exe", p "switching.x86.exe")+ , ("obj", p "switching-refined.x86.o")+ , ("include", p "switching.h")+ , ("c++-include", p "switching.hh")+ , ("plain", p "switching")+ ]+ ] } , Sweets { rootMatchName = "tailrecurse.c"@@ -260,34 +197,17 @@ , rootFile = p "tailrecurse.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),- ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")- , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),- ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")- ]- }+ [ exp1 "tailrecurse.expected" (a "ppc") (a "refined")+ "tailrecurse.ppc.exe"++ , exp1 "tailrecurse.expected" (a "ppc") (a "base")+ "tailrecurse.ppc.exe"++ , exp1 "tailrecurse.x86.expected" (e "x86") (a "refined")+ "tailrecurse.x86.exe"++ , exp1 "tailrecurse.x86.expected" (e "x86") (a "base")+ "tailrecurse.x86.exe" ] } ]
test/TestNoAssoc.hs view
@@ -26,18 +26,97 @@ noAssocTests :: [TT.TestTree] noAssocTests =- let (sugar1,s1desc) = findSugarIn sugarCube (sample1 testInpPath)+ let (sugar1,s1desc) = findSugarIn sugarCube (sample1 sugarCube testInpPath)+ chkCandidate = checkCandidate sugarCube (\c -> sample1 c testInpPath)+ 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" $ 57 @=? length (sample1 testInpPath)+ testCase "valid sample" $ 57 @=? length (sample1 sugarCube testInpPath) - , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length+ , TT.testGroup "candidates"+ [+ chkCandidate 0 "global-max-good.c" []+ , chkCandidate 2 "global-max-good.ppc.o" [ ("arch", Explicit "ppc") ]+ , chkCandidate 2 "global-max-good.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 2 "global-max-good.ppc.expected" [ ("arch", Explicit "ppc") ]+ , chkCandidate 2 "global-max-good.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 2 "global-max-good.x86.expected" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "jumpfar.c" []+ , chkCandidate 0 "jumpfar.h" []+ , chkCandidate 0 "jumpfar.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "jumpfar.ppc.o" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "jumpfar.ppc.expected" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "jumpfar.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "jumpfar.x86.expected" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "looping.c" []+ , chkCandidate 0 "looping.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "looping.ppc.expected" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "looping.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "looping.x86.expected" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "looping-around.c" []+ , chkCandidate 1 "looping-around.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 1 "looping-around.ppc.expected" [ ("arch", Explicit "ppc") ]+ , chkCandidate 1 "looping-around.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "looping-around.expected" []+ , chkCandidate 0 "Makefile" []+ , chkCandidate 0 "README.org" []+ , chkCandidate 0 "switching" []+ , chkCandidate 0 "switching_stuff" []+ , chkCandidate 0 "switching.c" []+ , chkCandidate 0 "switching.h" []+ , chkCandidate 0 "switching.hh" []+ , chkCandidate 0 "switching_llvm.c" []+ , chkCandidate 0 "switching_llvm.h" []+ , chkCandidate 0 "switching_llvm.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "switching_many.c" []+ , chkCandidate 0 "switching_many_llvm.c" []+ , chkCandidate 0 "switching_many_llvm.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "switching_many.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "switching.ppc.base-expected" [ ("arch", Explicit "ppc")+ , ("form", Explicit "base") ]+ , chkCandidate 0 "switching.ppc.o" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "switching.ppc.base.o" [ ("arch", Explicit "ppc")+ , ("form", Explicit "base") ]+ , chkCandidate 0 "switching.ppc.extra.o" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "switching.ppc.other" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "switching.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "switching.x86.base-expected" [ ("arch", Explicit "x86")+ , ("form", Explicit "base") ]+ , chkCandidate 0 "switching.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "switching-refined.x86.o" [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ]+ , chkCandidate 0 "switching.x86.orig" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "switching.x86.refined-expected" [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ]+ , chkCandidate 0 "switching.x86.refined-expected-orig" [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ]+ , chkCandidate 0 "switching.x86.refined-last-actual" [ ("arch", Explicit "x86")+ , ("form", Explicit "refined") ]+ , chkCandidate 0 "tailrecurse.c" []+ , chkCandidate 0 "tailrecurse.expected" []+ , chkCandidate 0 "tailrecurse.expected.expected" []+ , chkCandidate 0 "tailrecurse.food.expected" []+ , chkCandidate 0 "tailrecurse.ppc.exe" [ ("arch", Explicit "ppc") ]+ , chkCandidate 0 "tailrecurse.x86.exe" [ ("arch", Explicit "x86") ]+ , chkCandidate 0 "tailrecurse.x86.expected" [ ("arch", Explicit "x86") ]+ ] + , sugarTestEq "correct found count" sugarCube+ (flip sample1 testInpPath) 6 length+ , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in+ let exp0 e a f =+ Expectation { expectedFile = p e+ , expParamsMatch = [("arch", a), ("form", f)]+ , associated = []+ }+ e = Explicit+ a = Assumed+ in [ Sweets { rootMatchName = "global-max-good.c" , rootBaseName = "global-max-good"@@ -45,30 +124,10 @@ , cubeParams = validParams sugarCube , expected = [- Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "base")]- , associated = []- }- , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "refined")]- , associated = []- }- , Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),- ("form", Assumed "base")]- , associated = []- }- , Expectation- { expectedFile = p "global-max-good.x86.expected"- , expParamsMatch = [("arch", Explicit "x86"),- ("form", Assumed "refined")]- , associated = []- }+ exp0 "global-max-good.ppc.expected" (e "ppc") (a "refined")+ , exp0 "global-max-good.ppc.expected" (e "ppc") (a "base")+ , exp0 "global-max-good.x86.expected" (e "x86") (a "refined")+ , exp0 "global-max-good.x86.expected" (e "x86") (a "base") ] } @@ -77,30 +136,10 @@ , rootFile = p "jumpfar.c" , 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") ]- , associated = []- }- , Expectation- { expectedFile = p "jumpfar.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined")]- , associated = []- }+ [ exp0 "jumpfar.ppc.expected" (e "ppc") (a "refined")+ , exp0 "jumpfar.ppc.expected" (e "ppc") (a "base")+ , exp0 "jumpfar.x86.expected" (e "x86") (a "refined")+ , exp0 "jumpfar.x86.expected" (e "x86") (a "base") ] } , Sweets { rootMatchName = "looping.c"@@ -108,30 +147,10 @@ , 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 "looping.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , associated = []- }- , Expectation- { expectedFile = p "looping.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "base") ]- , associated = []- }- , Expectation- { expectedFile = p "looping.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined")]- , associated = []- }+ [ exp0 "looping.ppc.expected" (e "ppc") (a "refined")+ , exp0 "looping.ppc.expected" (e "ppc") (a "base")+ , exp0 "looping.x86.expected" (e "x86") (a "refined")+ , exp0 "looping.x86.expected" (e "x86") (a "base") ] } , Sweets { rootMatchName = "looping-around.c"@@ -139,30 +158,10 @@ , 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-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , associated = []- }- , Expectation- { expectedFile = p "looping-around.expected"- , expParamsMatch = [ ("arch", Assumed "x86")- , ("form", Assumed "base") ]- , associated = []- }- , Expectation- { expectedFile = p "looping-around.expected"- , expParamsMatch = [ ("arch", Assumed "x86")- , ("form", Assumed "refined")]- , associated = []- }+ [ exp0 "looping-around.expected" (a "x86") (a "refined")+ , exp0 "looping-around.expected" (a "x86") (a "base")+ , exp0 "looping-around.ppc.expected" (e "ppc") (a "refined")+ , exp0 "looping-around.ppc.expected" (e "ppc") (a "base") ] } , Sweets { rootMatchName = "switching.c"@@ -170,58 +169,20 @@ , rootFile = p "switching.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "switching.ppc.base-expected"- , expParamsMatch = [ ("arch", Explicit "ppc")- , ("form", Explicit "base")- ]- , associated = []- }- , Expectation- { expectedFile = p "switching.x86.base-expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Explicit "base")- ]- , associated = []- }- , Expectation- { expectedFile = p "switching.x86.refined-expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Explicit "refined")- ]- , associated = []- }- ]- }+ [ exp0 "switching.ppc.base-expected" (e "ppc") (e "base")+ , exp0 "switching.x86.base-expected" (e "x86") (e "base")+ , exp0 "switching.x86.refined-expected" (e "x86") (e "refined")+ ]+ } , Sweets { rootMatchName = "tailrecurse.c" , rootBaseName = "tailrecurse" , rootFile = p "tailrecurse.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),- ("form", Assumed "base") ]- , associated = []- }- , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")- , ("form", Assumed "refined") ]- , associated = []- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),- ("form", Assumed "base") ]- , associated = []- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined") ]- , associated = []- }+ [ exp0 "tailrecurse.expected" (a "ppc") (a "refined")+ , exp0 "tailrecurse.expected" (a "ppc") (a "base")+ , exp0 "tailrecurse.x86.expected" (e "x86") (a "refined")+ , exp0 "tailrecurse.x86.expected" (e "x86") (a "base") ] } ]@@ -230,7 +191,7 @@ mkNoAssocTests :: IO [TT.TestTree] mkNoAssocTests =- let (sugar1,s1desc) = findSugarIn sugarCube $ sample1 testInpPath+ let (sugar1,s1desc) = findSugarIn sugarCube $ sample1 sugarCube testInpPath in do tt <- withSugarGroups sugar1 TT.testGroup $ \sw idx exp -> -- Verify this will suppress the "refined" tests for
test/TestParamsAssoc.hs view
@@ -12,10 +12,8 @@ import Text.RawString.QQ -sample :: [CandidateFile]-sample = fmap (\f -> CandidateFile { candidateDir = testInpPath- , candidateSubdirs = []- , candidateFile = f })+sample :: CUBE -> [CandidateFile]+sample cube = fmap (makeCandidate cube testInpPath []) $ filter (not . null) $ lines [r| recursive.rs@@ -31,8 +29,29 @@ simple.clang-gcc.exe simple-opt.expct simple-opt.gcc-exe+alpha.exe+alpha.expct+alpha.clang.expct+alpha.x.expct+beta.exe+beta.expct+beta.clang.expct+beta......x.expct+gamma.exe+gamma.expct+gamma.clang.expct+gamma.x......expct+delta.exe+delta.expct+delta.clang.expct+delta......y.expct+epsilon.exe+epsilon.expct+epsilon.clang.expct+epsilon.y......expct |] + testInpPath = "test/params/samples" -- Note: in addition to other differences when compared to the tests@@ -53,137 +72,284 @@ , validParams = [ ("optimization", Nothing) ,("c-compiler", Just ["gcc", "clang"])+ ,("other", Just ["x"]) -- follows c-compiler+ ,("a param", Just ["y"]) -- preceeds c-compiler ] } paramsAssocTests :: [TT.TestTree] paramsAssocTests =- let (sugar1,_s1desc) = findSugarIn sugarCube 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+ let (sugar1,_s1desc) = findSugarIn sugarCube (sample sugarCube)+ chkCandidate = checkCandidate sugarCube sample testInpPath [] 0+ mkE' a cx cy p f c o = Expectation+ { expectedFile = p f+ , expParamsMatch = [ ("a param", cy "y")+ , ("c-compiler", c)+ , ("optimization", o)+ , ("other", cx "x")+ ]+ , associated = a+ }+ mkEr p = mkE' [ ("rust-source", p "recursive.rs") ] Assumed Assumed p+ mkEc p f c = mkE' [ ("c-source", p "simple.c") ] Assumed Assumed p f (Explicit c)+ mkEo cs p f c ca = mkE' [] cs ca p f c NotSpecified+ mkEq cs ca p f c = mkE' [] cs ca p f c+ p = (testInpPath </>)+ chkFld :: Eq a => Show a+ => Maybe Sweets -> String -> (Sweets -> a) -> a -> TT.TestTree+ chkFld s n f w = testCase n $ maybe (error "fail") f s @?= w+ chkExp s g n f c o = testCase ("Exp #" <> show n)+ $ (safeElem n . expected =<< s)+ @?= Just (g f c o)+ in [ testCase "valid sample" $ 33 @=? length (sample sugarCube)++ , TT.testGroup "candidates" [- Sweets { rootMatchName = "recursive.fast.exe"- , rootBaseName = "recursive"- , rootFile = p "recursive.fast.exe"- , cubeParams = validParams sugarCube- , expected =- [- Expectation- { expectedFile = p "recursive.fast.expct"- , expParamsMatch = [ ("optimization", Explicit "fast")- , ("c-compiler", Assumed "clang")- ]- , associated = [ ("rust-source", p "recursive.rs") ]- }- , Expectation- { expectedFile = p "recursive.fast.expct"- , expParamsMatch = [ ("optimization", Explicit "fast")- , ("c-compiler", Assumed "gcc")- ]- , associated = [ ("rust-source", p "recursive.rs") ]- }- ]- }+ chkCandidate "recursive.rs" []+ , chkCandidate "recursive.fast.exe" [("optimization", Explicit "fast")]+ , chkCandidate "simple.noopt.clang.exe" [("c-compiler", Explicit "clang")+ , ("optimization", Explicit "noopt")]+ , chkCandidate "simple.noopt.gcc.exe" [("c-compiler", Explicit "gcc")+ , ("optimization", Explicit "noopt")]+ , chkCandidate "simple.noopt-gcc.expct" [("c-compiler", Explicit "gcc")+ , ("optimization", Explicit "noopt")]+ , chkCandidate "simple.opt-clang.exe" [("c-compiler", Explicit "clang")+ , ("optimization", Explicit "opt")]+ , chkCandidate "simple.clang-noopt-clang.exe" [("c-compiler", Explicit "clang")+ , ("optimization", Explicit "noopt")]+ , chkCandidate "simple.clang-gcc.exe" [("c-compiler", Explicit "clang")+ ,("c-compiler", Explicit "gcc")]+ , chkCandidate "simple-opt.expct" [("optimization", Explicit "opt")]+ , chkCandidate "simple-opt.gcc-exe" [("c-compiler", Explicit "gcc")+ , ("optimization", Explicit "opt")]+ , chkCandidate "alpha.exe" []+ , chkCandidate "alpha.expct" []+ , chkCandidate "alpha.clang.expct" [("c-compiler", Explicit "clang")]+ , chkCandidate "alpha.x.expct" [("other", Explicit "x")]+ , chkCandidate "beta.exe" []+ , chkCandidate "beta.expct" []+ , chkCandidate "beta.clang.expct" [("c-compiler", Explicit "clang")]+ , chkCandidate "beta......x.expct" [("other", Explicit "x")]+ , chkCandidate "gamma.exe" []+ , chkCandidate "gamma.expct" []+ , chkCandidate "gamma.clang.expct" [("c-compiler", Explicit "clang")]+ , chkCandidate "gamma.x......expct" [("other", Explicit "x")]+ , chkCandidate "delta.exe" []+ , chkCandidate "delta.expct" []+ , chkCandidate "delta.clang.expct" [("c-compiler", Explicit "clang")]+ , chkCandidate "delta......y.expct" [("a param", Explicit "y")]+ , chkCandidate "epsilon.exe" []+ , chkCandidate "epsilon.expct" []+ , chkCandidate "epsilon.clang.expct" [("c-compiler", Explicit "clang")]+ , chkCandidate "epsilon.y......expct" [("a param", Explicit "y")]+ ] - , Sweets { rootMatchName = "simple.noopt.clang.exe"- , rootBaseName = "simple"- , rootFile = p "simple.noopt.clang.exe"- , cubeParams = validParams sugarCube- , expected =- [- Expectation- { expectedFile = p "simple.expct"- , expParamsMatch = [ ("optimization", Explicit "noopt")- , ("c-compiler", Explicit "clang")- ]- , associated = [ ("c-source", p "simple.c")]- }- ]- }+ , sugarTestEq "correct found count" sugarCube sample 11 length - , Sweets { rootMatchName = "simple.noopt.gcc.exe"- , rootBaseName = "simple"- , rootFile = p "simple.noopt.gcc.exe"- , cubeParams = validParams sugarCube- , expected =- [ Expectation- { expectedFile = p "simple.noopt-gcc.expct"- , expParamsMatch = [ ("optimization", Explicit "noopt")- , ("c-compiler", Explicit "gcc")- ]- , associated = [ ("c-source", p "simple.c")]- }- ]- }+ , let sweetNum = 5+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEr p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "recursive.fast.exe"+ , chkF "rootBaseName" rootBaseName "recursive"+ , chkF "rootFile" rootFile $ p "recursive.fast.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ , chkE 1 "recursive.fast.expct" (Assumed "clang") (Explicit "fast")+ , chkE 0 "recursive.fast.expct" (Assumed "gcc") (Explicit "fast")+ ] - , Sweets { rootMatchName = "simple.opt-clang.exe"- , rootBaseName = "simple"- , rootFile = p "simple.opt-clang.exe"- , cubeParams = validParams sugarCube- , expected =- [ Expectation- { expectedFile = p "simple-opt.expct"- , expParamsMatch = [ ("optimization", Explicit "opt")- , ("c-compiler", Explicit "clang")- ]- , associated = [ ("c-source", p "simple.c")]- }- ]- }+ , let sweetNum = 8+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEc p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "simple.noopt.clang.exe"+ , chkF "rootBaseName" rootBaseName "simple"+ , chkF "rootFile" rootFile $ p "simple.noopt.clang.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- Note that opt is an unconstrained parameter, so it can+ -- match "noopt" or it can match something else.+ , chkE 0 "simple-opt.expct" "clang" (Explicit "opt")+ , chkE 1 "simple.expct" "clang" NotSpecified+ , chkE 2 "simple.expct" "clang" (Explicit "noopt")+ ] - -- This repeats a parameter value, which nullifies any- -- parameter matching and so those elements that look like- -- parameters are just part of the base.- , Sweets { rootMatchName = "simple.clang-noopt-clang.exe"- , rootBaseName = "simple"- , rootFile = p "simple.clang-noopt-clang.exe"- , cubeParams = validParams sugarCube- , expected =- [ Expectation- { expectedFile = p "simple.expct"- , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "clang")- ]- , associated = [ ("c-source", p "simple.c")]- }- , Expectation- { expectedFile = p "simple.expct"- , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "gcc")- ]- , associated = [ ("c-source", p "simple.c")]- }- ]- }+ , let sweetNum = 9+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEc p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "simple.noopt.gcc.exe"+ , chkF "rootBaseName" rootBaseName "simple"+ , chkF "rootFile" rootFile $ p "simple.noopt.gcc.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- Note that opt is an unconstrained parameter, so it can+ -- match "noopt" or it can match something else.+ , chkE 0 "simple-opt.expct" "gcc" (Explicit "opt")+ , chkE 1 "simple.noopt-gcc.expct" "gcc" NotSpecified+ , chkE 2 "simple.noopt-gcc.expct" "gcc" (Explicit "noopt")+ ] - -- This repeats a parameter with a different value, which- -- nullifies any parameter matching and so those elements- -- that look like parameters are just part of the base.- , Sweets { rootMatchName = "simple.clang-gcc.exe"- , rootBaseName = "simple"- , rootFile = p "simple.clang-gcc.exe"- , cubeParams = validParams sugarCube- , expected =- [ Expectation- { expectedFile = p "simple.expct"- , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "clang")- ]- , associated = [ ("c-source", p "simple.c")]- }- , Expectation- { expectedFile = p "simple.expct"- , expParamsMatch = [ ("optimization", NotSpecified)- , ("c-compiler", Assumed "gcc")- ]- , associated = [ ("c-source", p "simple.c")]- }- ]- }+ , let sweetNum = 10+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEc p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "simple.opt-clang.exe"+ , chkF "rootBaseName" rootBaseName "simple"+ , chkF "rootFile" rootFile $ p "simple.opt-clang.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- Note that opt is an unconstrained parameter, so it can+ -- match "noopt" or it can match something else.+ , chkE 0 "simple-opt.expct" "clang" (Explicit "opt")+ , chkE 1 "simple.expct" "clang" NotSpecified+ ] + -- This repeats a parameter value and also matches with a different+ -- value. The duplicate value should be ignored, but both values should+ -- result in different Expectations.+ , let sweetNum = 7+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEc p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "simple.clang-noopt-clang.exe"+ , chkF "rootBaseName" rootBaseName "simple"+ , chkF "rootFile" rootFile $ p "simple.clang-noopt-clang.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- Note that opt is an unconstrained parameter, so it can+ -- match "noopt" or it can match something else.+ , chkE 0 "simple-opt.expct" "clang" (Explicit "opt")+ , chkE 1 "simple.expct" "clang" NotSpecified+ , chkE 2 "simple.expct" "clang" (Explicit "noopt")+ ]++ -- This repeats a parameter with a different value, which causes a+ -- separate explicit match to be claimed for each value. In addition,+ -- the optimization parameter has no value specified, so multiple values+ -- are found that could be tried, along with an expect file that doesn't+ -- supply a potential value for this parameter.+ , let sweetNum = 6+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE = chkExp sweet (mkEc p)+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "simple.clang-gcc.exe"+ , chkF "rootBaseName" rootBaseName "simple"+ , chkF "rootFile" rootFile $ p "simple.clang-gcc.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ , chkE 1 "simple-opt.expct" "clang" (Explicit "opt")+ , chkE 0 "simple-opt.expct" "gcc" (Explicit "opt")+ , chkE 2 "simple.expct" "clang" NotSpecified+ , chkE 3 "simple.noopt-gcc.expct" "gcc" NotSpecified+ , chkE 4 "simple.noopt-gcc.expct" "gcc" (Explicit "noopt")+ ]+ -- n.b. simple-opt.gcc-exe is *not* matched: the rootname is -- "*.exe" so the '.' separator is required.- ]++ -- Verify that Expectations are selected based on better ParamMatches+ -- (sorted).+ , let sweetNum = 0+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE n cs ca f c = chkExp sweet (mkEq cs ca p) n f c NotSpecified+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "alpha.exe"+ , chkF "rootBaseName" rootBaseName "alpha"+ , chkF "rootFile" rootFile $ p "alpha.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ , chkE 0 Assumed Assumed "alpha.clang.expct" (Explicit "clang")+ , chkE 1 Explicit Assumed "alpha.x.expct" (Assumed "gcc")+ ]++ -- Verify that lengthening the expected filename by adding separators will+ -- not change the parameter identification but will select the longer+ -- expected filename *if* the parameter is higher (sorted on parameter+ -- name).+ , let sweetNum = 1+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE n cs ca f c = chkExp sweet (mkEq cs ca p) n f c NotSpecified+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "beta.exe"+ , chkF "rootBaseName" rootBaseName "beta"+ , chkF "rootFile" rootFile $ p "beta.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- sorted: "c-compiler":"clang", "other":"x", so clang is preferred.+ , chkE 0 Explicit Assumed "beta......x.expct" (Assumed "gcc")+ , chkE 1 Assumed Assumed "beta.clang.expct" (Explicit "clang")+ ]++ -- This is the same as beta, but with the separator extensions on the+ -- other side.+ , let sweetNum = 4+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE n cs ca f c = chkExp sweet (mkEq cs ca p) n f c NotSpecified+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "gamma.exe"+ , chkF "rootBaseName" rootBaseName "gamma"+ , chkF "rootFile" rootFile $ p "gamma.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- sorted: "c-compiler":"clang", "other":"x", so clang is preferred.+ , chkE 0 Assumed Assumed "gamma.clang.expct" (Explicit "clang")+ , chkE 1 Explicit Assumed "gamma.x......expct" (Assumed "gcc")+ ]++ -- This is the same as beta, but with a higher-precedence parameter+ , let sweetNum = 2+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE n cs ca f c = chkExp sweet (mkEq cs ca p) n f c NotSpecified+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "delta.exe"+ , chkF "rootBaseName" rootBaseName "delta"+ , chkF "rootFile" rootFile $ p "delta.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- sorted: "a param":"y", "c-compiler":"clang" so "a param" is+ -- preferred.+ , chkE 1 Assumed Explicit "delta......y.expct" (Assumed "clang")+ , chkE 0 Assumed Explicit "delta......y.expct" (Assumed "gcc")+ ]++ -- This is the same as beta, but with the separator extensions on the+ -- other side.+ , let sweetNum = 3+ sweet = safeElem sweetNum sugar1+ chkF = chkFld sweet+ chkP = chkFld sweet+ chkE n cs ca f c = chkExp sweet (mkEq cs ca p) n f c NotSpecified+ in TT.testGroup ("Sweet #" <> show sweetNum)+ [+ chkF "rootMatchName" rootMatchName "epsilon.exe"+ , chkF "rootBaseName" rootBaseName "epsilon"+ , chkF "rootFile" rootFile $ p "epsilon.exe"+ , chkP "cubeParams" cubeParams $ validParams sugarCube+ -- sorted: "a param":"y", "c-compiler":"clang" so "a param" is+ -- preferred.+ , chkE 1 Assumed Explicit "epsilon.y......expct" (Assumed "clang")+ , chkE 0 Assumed Explicit "epsilon.y......expct" (Assumed "gcc")+ ] ]
test/TestSingleAssoc.hs view
@@ -26,18 +26,27 @@ singleAssocTests :: [TT.TestTree] singleAssocTests =- let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 testInpPath)+ let (sugar1,_s1desc) = findSugarIn sugarCube (sample1 sugarCube 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" $ 57 @=? length (sample1 testInpPath)+ testCase "valid sample" $ 57 @=? length (sample1 sugarCube testInpPath) - , sugarTestEq "correct found count" sugarCube (sample1 testInpPath) 6 length+ , sugarTestEq "correct found count" sugarCube+ (flip sample1 testInpPath) 6 length , testCase "results" $ compareBags "results" sugar1 $ let p = (testInpPath </>) in+ let exp1 e a f x =+ Expectation { expectedFile = p e+ , expParamsMatch = [("arch", a), ("form", f)]+ , associated = [("exe", p x)]+ }+ e = Explicit+ a = Assumed+ in [ Sweets { rootMatchName = "global-max-good.c" , rootBaseName = "global-max-good"@@ -45,34 +54,17 @@ , cubeParams = validParams sugarCube , expected = [- Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "base")]- , associated = [ ("exe", p "global-max-good.ppc.exe")- ]- }- , Expectation- { expectedFile = p "global-max-good.ppc.expected"- , expParamsMatch = [("arch", Explicit "ppc"),- ("form", Assumed "refined")]- , associated = [ ("exe", p "global-max-good.ppc.exe")- ]- }- , 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")- ]- }+ exp1 "global-max-good.ppc.expected" (e "ppc") (a "refined")+ "global-max-good.ppc.exe"++ , exp1 "global-max-good.ppc.expected" (e "ppc") (a "base")+ "global-max-good.ppc.exe"++ , exp1 "global-max-good.x86.expected" (e "x86") (a "refined")+ "global-max-good.x86.exe"++ , exp1 "global-max-good.x86.expected" (e "x86") (a "base")+ "global-max-good.x86.exe" ] } @@ -81,34 +73,17 @@ , rootFile = p "jumpfar.c" , 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") ]- , associated = [ ("exe", p "jumpfar.x86.exe")- ]- }- , Expectation- { expectedFile = p "jumpfar.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined")]- , associated = [ ("exe", p "jumpfar.x86.exe")- ]- }+ [ exp1 "jumpfar.ppc.expected" (e "ppc") (a "refined")+ "jumpfar.ppc.exe"++ , exp1 "jumpfar.ppc.expected" (e "ppc") (a "base")+ "jumpfar.ppc.exe"++ , exp1 "jumpfar.x86.expected" (e "x86") (a "refined")+ "jumpfar.x86.exe"++ , exp1 "jumpfar.x86.expected" (e "x86") (a "base")+ "jumpfar.x86.exe" ] } , Sweets { rootMatchName = "looping.c"@@ -116,34 +91,17 @@ , rootFile = p "looping.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "looping.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "base") ]- , associated = [ ("exe", p "looping.ppc.exe")- ]- }- , Expectation- { expectedFile = p "looping.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , 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")- ]- }+ [ exp1 "looping.ppc.expected" (e "ppc") (a "refined")+ "looping.ppc.exe"++ , exp1 "looping.ppc.expected" (e "ppc") (a "base")+ "looping.ppc.exe"++ , exp1 "looping.x86.expected" (e "x86") (a "refined")+ "looping.x86.exe"++ , exp1 "looping.x86.expected" (e "x86") (a "base")+ "looping.x86.exe" ] } , Sweets { rootMatchName = "looping-around.c"@@ -151,34 +109,17 @@ , 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-around.ppc.exe")- ]- }- , Expectation- { expectedFile = p "looping-around.ppc.expected"- , expParamsMatch = [ ("arch" , Explicit "ppc")- , ("form" , Assumed "refined") ]- , 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")- ]- }+ [ exp1 "looping-around.expected" (a "x86") (a "refined")+ "looping-around.x86.exe"++ , exp1 "looping-around.expected" (a "x86") (a "base")+ "looping-around.x86.exe"++ , exp1 "looping-around.ppc.expected" (e "ppc") (a "refined")+ "looping-around.ppc.exe"++ , exp1 "looping-around.ppc.expected" (e "ppc") (a "base")+ "looping-around.ppc.exe" ] } , Sweets { rootMatchName = "switching.c"@@ -186,30 +127,14 @@ , rootFile = p "switching.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "switching.ppc.base-expected"- , expParamsMatch = [ ("arch", Explicit "ppc")- , ("form", Explicit "base")- ]- , associated = [ ("exe", p "switching.ppc.exe")- ]- }- , Expectation- { expectedFile = p "switching.x86.base-expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Explicit "base")- ]- , associated = [ ("exe", p "switching.x86.exe")- ]- }- , Expectation- { expectedFile = p "switching.x86.refined-expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Explicit "refined")- ]- , associated = [ ("exe", p "switching.x86.exe")- ]- }+ [ exp1 "switching.ppc.base-expected" (e "ppc") (e "base")+ "switching.ppc.exe"++ , exp1 "switching.x86.base-expected" (e "x86") (e "base")+ "switching.x86.exe"++ , exp1 "switching.x86.refined-expected" (e "x86") (e "refined")+ "switching.x86.exe" ] } , Sweets { rootMatchName = "tailrecurse.c"@@ -217,34 +142,17 @@ , rootFile = p "tailrecurse.c" , cubeParams = validParams sugarCube , expected =- [ Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc"),- ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.expected"- , expParamsMatch = [ ("arch", Assumed "ppc")- , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.ppc.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86"),- ("form", Assumed "base") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")- ]- }- , Expectation- { expectedFile = p "tailrecurse.x86.expected"- , expParamsMatch = [ ("arch", Explicit "x86")- , ("form", Assumed "refined") ]- , associated = [ ("exe", p "tailrecurse.x86.exe")- ]- }+ [ exp1 "tailrecurse.expected" (a "ppc") (a "refined")+ "tailrecurse.ppc.exe"++ , exp1 "tailrecurse.expected" (a "ppc") (a "base")+ "tailrecurse.ppc.exe"++ , exp1 "tailrecurse.x86.expected" (e "x86") (a "refined")+ "tailrecurse.x86.exe"++ , exp1 "tailrecurse.x86.expected" (e "x86") (a "base")+ "tailrecurse.x86.exe" ] } ]
test/TestStrlen2.hs view
@@ -30,10 +30,63 @@ strlen2SampleTests :: [TT.TestTree] strlen2SampleTests =- let (sugar,sdesc) = findSugarIn sugarCube strlen2Samples- in [ testCase "valid sample" $ 24 @=? length strlen2Samples+ let (sugar,sdesc) = findSugarIn sugarCube (strlen2Samples sugarCube)+ chkCandidate = checkCandidate sugarCube strlen2Samples testInpPath [] 0+ in [ testCase "valid sample" $ 24 @=? length (strlen2Samples sugarCube) , sugarTestEq "correct found count" sugarCube strlen2Samples 1 length + , TT.testGroup "candidates"+ [+ chkCandidate "strlen_test2.boolector.boolector.out"+ [ ("solver", Explicit "boolector") ]+ , chkCandidate "strlen_test2.boolector.boolector.print.out"+ [ ("solver", Explicit "boolector") ]+ , chkCandidate "strlen_test2.boolector.good"+ [ ("solver", Explicit "boolector") ]+ , chkCandidate "strlen_test2.boolector.loopmerge.good"+ [ ("loop-merging", Explicit "loopmerge")+ , ("solver", Explicit "boolector")+ ]+ , chkCandidate "strlen_test2.c" []+ , chkCandidate "strlen_test2.cvc4.cvc4.out"+ [ ("solver", Explicit "cvc4") ]+ , chkCandidate "strlen_test2.cvc4.loop.good"+ [ ("loop-merging", Explicit "loop")+ , ("solver", Explicit "cvc4")+ ]+ , chkCandidate "strlen_test2.loopmerge.cvc4.good"+ [ ("loop-merging", Explicit "loopmerge")+ , ("solver", Explicit "cvc4")+ ]+ , chkCandidate "strlen_test2.good" []+ , chkCandidate "strlen_test2.loopmerge.config"+ [ ("loop-merging", Explicit "loopmerge") ]+ , chkCandidate "strlen_test2.loopmerge.stp.out"+ [ ("loop-merging", Explicit "loopmerge")+ ]+ , chkCandidate "strlen_test2.loopmerge.yices.out"+ [ ("loop-merging", Explicit "loopmerge")+ , ("solver", Explicit "yices")+ ]+ , chkCandidate "strlen_test2.loopmerge.yices.print.out"+ [ ("loop-merging", Explicit "loopmerge")+ , ("solver", Explicit "yices")+ ]+ , chkCandidate "strlen_test2.print" []+ , chkCandidate "strlen_test2.stp.out" []+ , chkCandidate "strlen_test2.stp.print.out" []+ , chkCandidate "strlen_test2.yices.out"+ [ ("solver", Explicit "yices") ]+ , chkCandidate "strlen_test2.yices.print.out"+ [ ("solver", Explicit "yices") ]+ , chkCandidate "strlen_test2.z3.good"+ [ ("solver", Explicit "z3") ]+ , chkCandidate "strlen_test2.z3.z3.out"+ [ ("solver", Explicit "z3") ]+ , chkCandidate "strlen_test2.z3.z3.print.out"+ [ ("solver", Explicit "z3") ]+ ]+ , testCaseSteps "sweets info" $ \step -> do step "rootMatchName" (rootMatchName <$> sugar) @?= ["strlen_test2.c"]@@ -46,78 +99,40 @@ , testCase "Expectations" $ compareBags "expected" (expected $ head sugar) $ let p = (testInpPath </>) in+ let exp1 e a f =+ Expectation { expectedFile = p e+ , expParamsMatch = [("solver", a), ("loop-merging", f)]+ , associated = [("stdio", p "strlen_test2.print")]+ }+ exp2 e a f c =+ let e1 = exp1 e a f+ in e1 { associated = ("config", p c) : associated e1 }+ e = Explicit+ a = Assumed+ l = "loop"+ m = "loopmerge"+ in [- Expectation- { expectedFile = p "strlen_test2.boolector.loopmerge.good"- , expParamsMatch = [ ("solver", Explicit "boolector")- , ("loop-merging", Explicit "loopmerge")- ]- , associated = [ ("config", p "strlen_test2.loopmerge.config")- , ("stdio", p "strlen_test2.print")- ]- }- , Expectation- { expectedFile = p "strlen_test2.boolector.good"- , expParamsMatch = [ ("solver", Explicit "boolector")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("stdio", p "strlen_test2.print")- ]- }+ exp2 "strlen_test2.boolector.loopmerge.good" (e "boolector") (e m)+ "strlen_test2.loopmerge.config" - , Expectation- { expectedFile = p "strlen_test2.loopmerge.cvc4.good"- , expParamsMatch = [ ("solver", Explicit "cvc4")- , ("loop-merging", Explicit "loopmerge")- ]- , associated = [ ("config", p "strlen_test2.loopmerge.config")- , ("stdio", p "strlen_test2.print")- ]- }- , Expectation- { expectedFile = p "strlen_test2.cvc4.loop.good"- , expParamsMatch = [ ("solver", Explicit "cvc4")- , ("loop-merging", Explicit "loop")- ]- , associated = [ ("stdio", p "strlen_test2.print")- ]- }+ , exp1 "strlen_test2.boolector.good" (e "boolector") (a l) - , Expectation- { expectedFile = p "strlen_test2.loopmerge.good"- , expParamsMatch = [ ("loop-merging", Explicit "loopmerge")- , ("solver", Assumed "yices")- ]- , associated = [ ("config", p "strlen_test2.loopmerge.config")- , ("stdio", p "strlen_test2.print")- ]- }- , Expectation- { expectedFile = p "strlen_test2.good"- , expParamsMatch = [ ("loop-merging", Assumed "loop")- , ("solver", Assumed "yices")- ]- , associated = [ ("stdio", p "strlen_test2.print")- ]- }+ , exp2 "strlen_test2.loopmerge.cvc4.good" (e "cvc4") (e m)+ "strlen_test2.loopmerge.config" - , Expectation- { expectedFile = p "strlen_test2.z3.good"- , expParamsMatch = [ ("solver", Explicit "z3")- , ("loop-merging", Assumed "loopmerge")- ]- , associated = [ ("config", p "strlen_test2.loopmerge.config")- , ("stdio", p "strlen_test2.print")- ]- }- , Expectation- { expectedFile = p "strlen_test2.z3.good"- , expParamsMatch = [ ("solver", Explicit "z3")- , ("loop-merging", Assumed "loop")- ]- , associated = [ ("stdio", p "strlen_test2.print")- ]- }+ , exp1 "strlen_test2.cvc4.loop.good" (e "cvc4") (e l)++ , exp2 "strlen_test2.loopmerge.good" (a "yices") (e m)+ "strlen_test2.loopmerge.config"++ , exp1 "strlen_test2.good" (a "yices") (a l)++ , exp2 "strlen_test2.loopmerge.good" (a "z3") (e m)+ "strlen_test2.loopmerge.config"++ , exp1 "strlen_test2.z3.good" (e "z3") (a l)+ -- 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@@ -143,11 +158,9 @@ ] ] -strlen2Samples = fmap (\f -> CandidateFile { candidateDir = "test-data/samples"- , candidateSubdirs = []- , candidateFile = f })- $ filter (not . null)- $ lines [r|+strlen2Samples cube = fmap (makeCandidate cube "test-data/samples" [])+ $ filter (not . null)+ $ lines [r| strlen_test2.boolector.boolector.out strlen_test2.boolector.boolector.print.out strlen_test2.boolector.good
test/TestUtils.hs view
@@ -48,11 +48,19 @@ testEach = map testElem $ zip3 [0..] lst elemTests in testCase (name <> " count") (assertEqual "length" (length elemTests) (length lst)) : testEach +safeElem :: Int -> [a] -> Maybe a+safeElem idx lst = case drop idx lst of+ [] -> Nothing+ (e:_) -> Just e compareBags name gotBag expBag = if gotBag `elem` L.permutations expBag then return ()- else let expCnt = length expBag+ else mismatchedColl name gotBag expBag+++mismatchedColl name gotBag expBag =+ let expCnt = length expBag gotCnt = length gotBag uGot = L.nub gotBag expUCnt = length $ L.nub expBag@@ -116,5 +124,32 @@ sugarTestEq name cube sample expVal test =- let (r,d) = findSugarIn cube sample+ let (r,d) = findSugarIn cube (sample cube) in testCase name $ eqTestWithFailInfo d expVal $ test r+++checkCandidate cube files path subdirs sepSkip nm pm =+ testCase (nm <> " candidate")+ $ L.find (\c -> and [ nm == candidateFile c+ , subdirs == candidateSubdirs c+ ]) (files cube)+ @?= Just (CandidateFile { candidateDir = path+ , candidateSubdirs = subdirs+ , candidateFile = nm+ , candidatePMatch = pm+ , candidateMatchIdx = toEnum+ $ let isSep = (`elem` (separators cube))+ sepsAt = L.findIndices isSep nm+ fstSep = case L.drop sepSkip sepsAt of+ (l:_) -> Just l+ [] -> Nothing+ lstSep = case reverse sepsAt of+ (l:_) -> Just l+ [] -> Nothing+ ln = length nm+ in if null pm+ then maybe ln (1+) lstSep+ else if null pm+ then ln+ else maybe ln (+1) fstSep+ })
test/TestWildcard.hs view
@@ -22,14 +22,13 @@ testInpPath = "some/path/to/test/samples" -sample1 = fmap (\f -> CandidateFile { candidateDir = testInpPath- , candidateSubdirs = []- , candidateFile = f })+sample1 cube = fmap (makeCandidate cube testInpPath []) $ filter (not . null) $ lines [r| foo foo.exp foo.ex+foo.right.exp bar.exp bar. bar-ex@@ -45,7 +44,14 @@ wildcardAssocTests :: [TT.TestTree] wildcardAssocTests =- [ testCase "valid sample" $ 13 @=? length sample1+ [ let sugarCube = mkCUBE+ { rootName = "*"+ , expectedSuffix = "exp"+ , inputDirs = [ testInpPath ]+ , associatedNames = [ ("extern", "ex") ]+ }+ p = (testInpPath </>)+ in testCase "valid sample" $ 14 @=? length (sample1 sugarCube) -- The first CUBE uses the default set of separators, and the expected -- suffix does not limit which separators can preceed the suffix.@@ -57,6 +63,17 @@ , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)+ exp e = Expectation { expectedFile = p e+ , associated = []+ , expParamsMatch = []+ }+ expE e a = (exp e) { associated = [("extern", p a)] }+ sw m b f e = Sweets { rootBaseName = b+ , rootMatchName = m+ , rootFile = p f+ , cubeParams = []+ , expected = e+ } in [ sugarTestEq "correct found count" sugarCube sample1 5 length -- foo.ex is an associated name for foo, but removing its@@ -80,69 +97,13 @@ -- n.b. cow.moo is not matched because there is no separator in cow.mooexp , testCase "full results" $ compareBags "default result"- (fst $ findSugarIn sugarCube sample1) $+ (fst $ findSugarIn sugarCube (sample1 sugarCube)) $ let p = (testInpPath </>) in- [- Sweets { rootMatchName = "foo"- , rootBaseName = "foo"- , rootFile = p "foo"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "foo.exp"- , expParamsMatch = []- , associated = [ ("extern", p "foo.ex") ]- }- ]- }- , Sweets { rootMatchName = "foo.ex"- , rootBaseName = "foo"- , rootFile = p "foo.ex"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "foo.exp"- , expParamsMatch = []- , associated = []- }- ]- }- , Sweets { rootMatchName = "bar."- , rootBaseName = "bar"- , rootFile = p "bar."- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "bar.exp"- , expParamsMatch = []- , associated = [ ("extern", p "bar-ex") ]- }- ]- }- , Sweets { rootMatchName = "bar-ex"- , rootBaseName = "bar"- , rootFile = p "bar-ex"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "bar.exp"- , expParamsMatch = []- , associated = []- }- ]- }- , Sweets { rootMatchName = "dog.bark"- , rootBaseName = "dog.bark"- , rootFile = p "dog.bark"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "dog.bark-exp"- , expParamsMatch = []- , associated = []- }- ]- }+ [ sw "foo" "foo" "foo" [ expE "foo.exp" "foo.ex" ]+ , sw "foo.ex" "foo" "foo.ex" [ exp "foo.exp" ]+ , sw "bar." "bar" "bar." [ expE "bar.exp" "bar-ex" ]+ , sw "bar-ex" "bar" "bar-ex" [ exp "bar.exp" ]+ , sw "dog.bark" "dog.bark" "dog.bark" [ exp "dog.bark-exp" ] ] ] @@ -157,6 +118,17 @@ , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)+ exp e = Expectation { expectedFile = p e+ , associated = []+ , expParamsMatch = []+ }+ expE e a = (exp e) { associated = [("extern", p a)] }+ sw m b f e = Sweets { rootBaseName = b+ , rootMatchName = m+ , rootFile = p f+ , cubeParams = []+ , expected = e+ } in [ sugarTestEq "correct found count" sugarCube sample1 2 length , sugarTestEq "bar is a case" sugarCube sample1 1 $ \sugar -> length [ x | x <- sugar, rootFile x == p "bar." ]@@ -167,33 +139,10 @@ -- expectedSuffix that is not a known separator , testCase "full results" $ compareBags "default result"- (fst $ findSugarIn sugarCube sample1) $+ (fst $ findSugarIn sugarCube (sample1 sugarCube)) $ let p = (testInpPath </>) in- [- Sweets { rootMatchName = "bar."- , rootBaseName = "bar."- , rootFile = p "bar."- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "bar.exp"- , expParamsMatch = []- , associated = []- }- ]- }- , Sweets { rootMatchName = "cow.moo"- , rootBaseName = "cow.moo"- , rootFile = p "cow.moo"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "cow.mooexp"- , expParamsMatch = []- , associated = [ ("extern", p "cow.mooex") ]- }- ]- }+ [ sw "bar." "bar." "bar." [ exp "bar.exp" ]+ , sw "cow.moo" "cow.moo" "cow.moo" [ expE "cow.mooexp" "cow.mooex" ] ] ] @@ -208,6 +157,17 @@ , associatedNames = [ ("extern", "ex") ] } p = (testInpPath </>)+ exp e = Expectation { expectedFile = p e+ , associated = []+ , expParamsMatch = []+ }+ expE e a = (exp e) { associated = [("extern", p a)] }+ sw m b f e = Sweets { rootBaseName = b+ , rootMatchName = m+ , rootFile = p f+ , cubeParams = []+ , expected = e+ } in [ sugarTestEq "correct found count" sugarCube sample1 4 length -- see notes for default seps tests above@@ -229,57 +189,82 @@ -- n.b. cow.moo is not matched because there is no separator in cow.mooexp , testCase "full results" $ compareBags "default result"- (fst $ findSugarIn sugarCube sample1) $+ (fst $ findSugarIn sugarCube (sample1 sugarCube)) $ let p = (testInpPath </>) in- [- Sweets { rootMatchName = "foo"- , rootBaseName = "foo"- , rootFile = p "foo"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "foo.exp"- , expParamsMatch = []- , associated = [ ("extern", p "foo.ex") ]- }- ]- }- , Sweets { rootMatchName = "foo.ex"- , rootBaseName = "foo"- , rootFile = p "foo.ex"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "foo.exp"- , expParamsMatch = []- , associated = []- }- ]- }- , Sweets { rootMatchName = "bar."- , rootBaseName = "bar"- , rootFile = p "bar."- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "bar.exp"- , expParamsMatch = []- , associated = [ ("extern", p "bar-ex") ]- }- ]+ [ sw "foo" "foo" "foo" [ expE "foo.exp" "foo.ex" ]+ , sw "foo.ex" "foo" "foo.ex" [ exp "foo.exp" ]+ , sw "bar." "bar" "bar." [ expE "bar.exp" "bar-ex" ]+ , sw "bar-ex" "bar" "bar-ex" [ exp "bar.exp" ]+ ]+ ]++ -- The fourth CUBE specifies one of the separators as part of the suffix, so+ -- only that separator is matched, and further specifies a non-wildcard+ -- suffix for the match (which occludes the associated name).+ , TT.testGroup "seps with suffix sep and root suffix" $+ let sugarCube = mkCUBE+ { rootName = "*.ex"+ , expectedSuffix = ".exp"+ , inputDirs = [ testInpPath ]+ , associatedNames = [ ("extern", "ex") ] }- , Sweets { rootMatchName = "bar-ex"- , rootBaseName = "bar"- , rootFile = p "bar-ex"- , cubeParams = []- , expected =- [ Expectation- { expectedFile = p "bar.exp"- , expParamsMatch = []- , associated = []- }- ]+ p = (testInpPath </>)+ exp e = Expectation { expectedFile = p e+ , associated = []+ , expParamsMatch = []+ }+ sw m b f e = Sweets { rootBaseName = b+ , rootMatchName = m+ , rootFile = p f+ , cubeParams = []+ , expected = e+ }+ in [ sugarTestEq "correct found count" sugarCube sample1 1 length+ , sugarTestEq "foo.ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]+ , testCase "full results" $+ compareBags "default result"+ (fst $ findSugarIn sugarCube (sample1 sugarCube)) $+ let p = (testInpPath </>) in+ [ sw "foo.ex" "foo" "foo.ex" [ exp "foo.exp" ]+ ]+ ]++ -- The fifth CUBE is like the fourth CUBE but it additionally matches+ -- parameters. The fifth CUBE (like the fourth) specifies one of the+ -- separators as part of the suffix, so only that separator is matched, and+ -- further specifies a non-wildcard suffix for the match (which occludes the+ -- associated name).+ , TT.testGroup "seps with suffix sep and root suffix and params" $+ let sugarCube = mkCUBE+ { rootName = "*.ex"+ , expectedSuffix = ".exp"+ , inputDirs = [ testInpPath ]+ , validParams = [ ("dir", Just [ "right", "left" ]) ]+ , associatedNames = [ ("extern", "ex") ] }+ p = (testInpPath </>)+ exp e d = Expectation { expectedFile = p e+ , associated = []+ , expParamsMatch = [ ("dir", d) ]+ }+ sw m b f e = Sweets { rootBaseName = b+ , rootMatchName = m+ , rootFile = p f+ , cubeParams = [("dir", Just ["right", "left"])]+ , expected = e+ }+ in [ sugarTestEq "correct found count" sugarCube sample1 1 length+ , sugarTestEq "foo.ex is a case" sugarCube sample1 1 $+ \sugar -> length [ x | x <- sugar, rootMatchName x == "foo.ex" ]+ , testCase "full results" $+ compareBags "default result"+ (fst $ findSugarIn sugarCube (sample1 sugarCube)) $+ let p = (testInpPath </>) in+ [ sw "foo.ex" "foo" "foo.ex"+ [ exp "foo.exp" (Assumed "left")+ , exp "foo.right.exp" (Explicit "right")+ ] ] ]
test/internals/test-internals.hs view
@@ -84,7 +84,7 @@ in testGroup "Expected trimming" [ testCase "non-explicit removals" $ pCmpExp (init sample)- (removeNonExplicitMatchingExpectations sample)+ (collateExpectations sample) , testCase "supermatch supercedes" $ -- Normally the trimming occurs on Expectations which all have@@ -94,6 +94,9 @@ -- supercede any Expectation that has the same set but fewer, -- as this test checks. This test is not critical to overall -- functionality, but serves to capture behavior.+ --+ -- Here, "adding" replaces the first element of sample because it+ -- otherwise matches sample but has more parameters. let adding = Expectation { expectedFile = "test.file" , expParamsMatch =@@ -104,10 +107,12 @@ ] , associated = [] }- test l = pCmpExp (adding : (tail $ init sample))- (removeNonExplicitMatchingExpectations l)- in mapM test (L.permutations $ adding : sample)- >> return ()+ test l = pCmpExp ((take 2 $ tail $ init sample)+ <> [adding]+ <> (drop 3 $ init sample)+ )+ (collateExpectations l)+ in mapM_ test (L.permutations $ adding : sample) , testCase "submatch removed" $ -- This is the inverse of the supermatch: an entry is added@@ -122,10 +127,8 @@ ] , associated = [] }- test l = pCmpExp (init sample)- (removeNonExplicitMatchingExpectations l)- in mapM test (L.permutations $ adding : sample)- >> return ()+ test l = pCmpExp (init sample) (collateExpectations l)+ in mapM_ test (L.permutations $ adding : sample) , testCase "superset and subset distinct" $ -- As a variation of the supermatch and submatch tests, if an@@ -149,16 +152,19 @@ [ ("foo", Explicit "a") , ("cow", Explicit "moo") -- Explicit "moo" here against Assumed "moo" plus two- -- more explicits... this gets removed+ -- more explicits above... this gets removed. Note+ -- also that this matches the first element of+ -- sample, but that element and the adding element+ -- above are incompatible, so this will be associated+ -- with one or the other, but not both. ] , associated = [] } ]- test l = pCmpExp (take 1 adding <> init sample)- (removeNonExplicitMatchingExpectations l)- in mapM test (L.permutations $ adding <> sample)- >> return ()+ test l = pCmpExp (take 1 adding <> init sample) (collateExpectations l)+ in mapM_ test (L.permutations $ adding <> sample) + , testCase "distinct if different" $ let adding = [ Expectation { expectedFile = "test.file"@@ -170,8 +176,7 @@ , associated = [] } ]- test l = pCmpExp (adding <> init sample)- (removeNonExplicitMatchingExpectations l)+ test l = pCmpExp (adding <> init sample) (collateExpectations l) in mapM test (L.permutations $ adding <> sample) >> return ()