packages feed

tasty-sugar 1.2.0.0 → 1.3.0.0

raw patch · 25 files changed

+2212/−554 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Test.Tasty.Sugar: CandidateFile :: FilePath -> [FilePath] -> FilePath -> CandidateFile
+ Test.Tasty.Sugar: [candidateDir] :: CandidateFile -> FilePath
+ Test.Tasty.Sugar: [candidateFile] :: CandidateFile -> FilePath
+ Test.Tasty.Sugar: [candidateSubdirs] :: CandidateFile -> [FilePath]
+ Test.Tasty.Sugar: [inputDirs] :: CUBE -> [FilePath]
+ Test.Tasty.Sugar: data CandidateFile
+ Test.Tasty.Sugar: getParamVal :: ParamMatch -> Maybe String
- Test.Tasty.Sugar: CUBE :: FilePath -> GlobPattern -> FileSuffix -> Separators -> [(String, FileSuffix)] -> [ParameterPattern] -> CUBE
+ Test.Tasty.Sugar: CUBE :: FilePath -> [FilePath] -> GlobPattern -> FileSuffix -> Separators -> [(String, FileSuffix)] -> [ParameterPattern] -> CUBE
- Test.Tasty.Sugar: findSugarIn :: CUBE -> [FilePath] -> ([Sweets], Doc ann)
+ Test.Tasty.Sugar: findSugarIn :: CUBE -> [CandidateFile] -> ([Sweets], Doc ann)

Files

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