tasty-sugar 2.2.3.2 → 2.2.3.3
raw patch · 7 files changed
+191/−42 lines, 7 filesnew-component:exe:test-passthru-ascii
Files
- CHANGELOG.md +4/−0
- README.org +10/−3
- src/internal/Test/Tasty/Sugar/ExpectCheck.hs +19/−5
- src/internal/Test/Tasty/Sugar/ParamCheck.hs +18/−17
- tasty-sugar.cabal +2/−3
- test/TestLLVMRange.hs +7/−8
- test/internals/test-internals.hs +131/−6
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for tasty-sugar +## 2.2.3.3 -- 2026-01-03++ * Fix to support matching multiple parameter values in a single candidate file.+ ## 2.2.3.2 -- 2025-12-15 * Widen tasty-hedgehog constraints to allow earlier v1.3.
README.org view
@@ -9,9 +9,14 @@ parameterization, and there can be associated files that are presented to the test as well. - The primary use of tasty-sugar is to _generate test cases_ based on- the contents of a directory, where the presence of various files- determine which tests are generated.+ The primary use of tasty-sugar is to _generate test cases_ based on the+ contents of a directory, where the presence of various files determine which+ tests are generated. More specifically, ~tasty-sugar~ identifies combinations+ of files that match the described pattern and invokes a user-supplied test+ generator function for each combination; the generator function creates tests+ that are then run via Tasty. The user's test generator function may perform+ additional validation to determine if one or more tests will be generated for+ each call. ** Elements of tasty-sugar: @@ -395,6 +400,8 @@ # ** Multiple Inputs with different parameters producing different outputs # # KWQ...++# KWQ: add RangedParam description * Comparisons
src/internal/Test/Tasty/Sugar/ExpectCheck.hs view
@@ -139,24 +139,38 @@ $ filter expMatch allNames guard $ isCompatible pvals efile - let onlyOneOfEach (p,v) r = case lookup p r of- Nothing -> (p,v) : r- Just _ -> r- rAndeMatches <- return (foldr onlyOneOfEach rmatch (candidatePMatch efile))+ let onlyOneOfEach r c@(p,v) =+ -- Note: there may be multiple c with same p and different v because+ -- the candidate file has multiple specifications for a particular+ -- parameter. Here, we want the one that matches what is in pvals or+ -- if there is not a match just take the first one.+ let matchesP = (p ==) . fst+ rootVals = filter matchesP pvals+ in case L.find (maybe False (`paramMatchVal` v) . snd) rootVals of+ Just _ ->+ -- matches rootVal, so use it and discard any others+ return $ c : filter (not . matchesP) r+ Nothing -> case lookup p r of+ Nothing -> return $ c : r -- first p, so use it+ Just _ -> return r+ rAndeMatches <- (foldM onlyOneOfEach rmatch (candidatePMatch $ efile)) <|> (if null unconstrained then mzero else let unConstr = (`elem` unconstrained) . fst rm = filter (not . unConstr) (candidatePMatch efile) in if null rm then mzero- else return (foldr onlyOneOfEach rmatch rm)+ else foldM onlyOneOfEach rmatch rm ) + let pmatch = namedPMatches rAndeMatches pvals assocFiles <- getAssoc rootPrefix seps pmatch assocNames $ filter (rootN /=) allNames++ return $ Expectation { expectedFile = candidateToPath efile , associated = fmap candidateToPath <$> assocFiles , expParamsMatch = L.sort pmatch
src/internal/Test/Tasty/Sugar/ParamCheck.hs view
@@ -52,13 +52,10 @@ namedPMatches :: [NamedParamMatch] -> [(String, Maybe String)] -> [NamedParamMatch] namedPMatches pmatch =- let inCore = (`elem` (fst <$> pmatch))- go = \case- [] -> pmatch- ((p, Just v):r) | not (inCore p) -> (p, Assumed v) : go r- ((p, Nothing):r) | not (inCore p) -> (p, NotSpecified) : go r- (_:r) -> go r- in go+ let addIfMissing (n,mbv) = maybe ((n, maybe NotSpecified Assumed mbv):)+ (flip const)+ $ lookup n pmatch+ in foldr addIfMissing pmatch -- | This provides an Ordering result of comparing two sets of NamedParamMatch.@@ -79,11 +76,10 @@ <> map (\k -> compare `on` (lookup k)) (fst <$> p1) in cascadeCompare comparisons p1 p2 +-- Runs multiple comparisons on two elements until the first comparison+-- thatreturns a non-EQ result. 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+cascadeCompare fs x y = mconcat [ f x y | f <- fs ] -- | Returns the maximum of two arguments based on comparing the@@ -99,12 +95,17 @@ -- 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.+--+-- Note that a particular candidate file may have multiple matching values for a+-- parameter. isCompatible :: [(String, Maybe String)] -> CandidateFile -> Bool-isCompatible pvals fname =- let isCompatParam (n,v) = case DL.lookup n pvals of- Nothing -> True- Just Nothing -> True- Just (Just cv) -> paramMatchVal cv v- in all isCompatParam $ candidatePMatch fname+isCompatible pvals candidatFile =+ let isCompatParamV v = \case+ Nothing -> True+ (Just cv) -> paramMatchVal cv v+ isCompatParam (n,mbv) =+ let nps = filter ((n ==) . fst) $ candidatePMatch candidatFile+ in null nps || any ((`isCompatParamV` mbv) . snd) nps+ in all isCompatParam pvals
tasty-sugar.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: tasty-sugar-version: 2.2.3.2+version: 2.2.3.3 synopsis: Tests defined by Search Using Golden Answer References description: .@@ -183,8 +183,7 @@ , text , transformers -test-suite test-passthru-ascii- type: exitcode-stdio-1.0+executable test-passthru-ascii hs-source-dirs: examples/example1 default-language: Haskell2010 GHC-options: -fhide-source-paths
test/TestLLVMRange.hs view
@@ -52,8 +52,7 @@ , "T847-fail2.clang12+.z3.good" , "T847-fail2.z3.good" , "T972-fail.c"- , "T972-fail.clang12+.z3.good"- , "T972-fail.clang14+.z3.good"+ , "T972-fail.clang12+.clang14+.z3.good" , "T972-fail.z3.good" , "abd-test-file-32.c" , "abd-test-file-32.config"@@ -641,9 +640,9 @@ case mode of "direct" -> [ expA "T972-fail.z3.good" "z3" "older-clang"- , expE "T972-fail.clang14+.z3.good" "z3" "clang14+"+ , expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang14+" , expA "T972-fail.z3.good" "z3" "clang13+"- , expE "T972-fail.clang12+.z3.good" "z3" "clang12+"+ , expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang12+" , expA "T972-fail.z3.good" "z3" "clang11+" ] "ranged" ->@@ -657,16 +656,16 @@ [ expA "T972-fail.z3.good" "z3" "clang11+" ] Just 12 ->- [ expE "T972-fail.clang12+.z3.good" "z3" "clang12+"+ [ expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang12+" ] Just 13 ->- [ expE "T972-fail.clang12+.z3.good" "z3" "clang12+"+ [ expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang12+" ] Just 14 ->- [ expE "T972-fail.clang14+.z3.good" "z3" "clang14+"+ [ expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang14+" ] Just 16 ->- [ expE "T972-fail.clang14+.z3.good" "z3" "clang14+"+ [ expE "T972-fail.clang12+.clang14+.z3.good" "z3" "clang14+" ] Nothing -> []
test/internals/test-internals.hs view
@@ -1,13 +1,15 @@ module Main where -import Control.Monad ( unless )+import Control.Monad ( unless ) import qualified Data.List as L-import Test.Tasty-import Test.Tasty.HUnit-import Text.Show.Pretty+import Test.Tasty+import Test.Tasty.HUnit+import Text.Show.Pretty -import Test.Tasty.Sugar.Types-import Test.Tasty.Sugar.ExpectCheck+import Test.Tasty.Sugar.Candidates+import Test.Tasty.Sugar.ExpectCheck+import Test.Tasty.Sugar.ParamCheck+import Test.Tasty.Sugar.Types main = defaultMain $@@ -180,6 +182,129 @@ in mapM test (L.permutations $ adding <> sample) >> return () + , testCase "multi-val-param matching" $+ let cand = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file.clang12+.clang14+.z3.exp"+ , candidatePMatch =+ [ ("clangtgt", Explicit "clang12+")+ , ("clangtgt", Explicit "clang14+")+ , ("solver", Explicit "z3")+ ]+ , candidateMatchIdx = 99+ }+ pvals1 = [ ("clangtgt", Just "clang12+"), ("solver", Just "z3") ]+ pvals2 = [ ("clangtgt", Just "clang14+"), ("solver", Just "z3") ]+ pvals3 = [ ("clangtgt", Just "clang12"), ("solver", Just "z3") ]+ in do isCompatible pvals1 cand @? "first multival"+ isCompatible pvals2 cand @? "second multival"+ not (isCompatible pvals3 cand) @? "no multival"++ , testCase "collation of expectations" $+ let exp1 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.z3.good"+ , expParamsMatch = [("clang-range",Assumed "clang11+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp2 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.clang12+.clang14+.z3.good"+ , expParamsMatch = [("clang-range",Explicit "clang12+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp3 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.z3.good"+ , expParamsMatch = [("clang-range",Assumed "clang12+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp4 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.z3.good"+ , expParamsMatch = [("clang-range",Assumed "clang13+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp5 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.clang12+.clang14+.z3.good"+ , expParamsMatch = [("clang-range",Explicit "clang14+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp6 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.z3.good"+ , expParamsMatch = [("clang-range",Assumed "clang14+")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ exp7 = Expectation+ { expectedFile = "test/data/llvm1/T972-fail.z3.good"+ , expParamsMatch = [("clang-range",Assumed "older-clang")+ ,("solver",Explicit "z3")]+ , associated = []+ }+ allExps = [exp1, exp2, exp3, exp4, exp5, exp6, exp7]+ in collateExpectations allExps @?= [exp7, exp5, exp4, exp2, exp1]+ -- ^ order of collateExpectations results doesn't really matter, so+ -- feel free to re-order this as needed.++ , testCase "matchStrength" $+ let cand1 = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file.clang12+.clang14+.z3.exp"+ , candidatePMatch =+ [ ("clangtgt", Explicit "clang12+")+ , ("clangtgt", Explicit "clang14+")+ , ("solver", Explicit "z3")+ ]+ , candidateMatchIdx = 99+ }+ cand2 = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file.z3.exp"+ , candidatePMatch =+ [ ("solver", Explicit "z3")+ ]+ , candidateMatchIdx = 99+ }+ strength1 = matchStrength (snd <$> (candidatePMatch cand1))+ strength2 = matchStrength (snd <$> (candidatePMatch cand2))+ in strength1 > strength2 @?+ ("candidate 1 strength of " <> show strength1+ <> " is not greater than candidate 2 strength of "+ <> show strength2)++ , testCase "candidateMatchPrefix" $+ let seps = "."+ rootPrefix = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file"+ , candidatePMatch = []+ , candidateMatchIdx = 5+ }+ expSuffix = "exp"+ cand1 = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file.clang12+.clang14+.z3.exp"+ , candidatePMatch =+ [ ("clangtgt", Explicit "clang12+")+ , ("clangtgt", Explicit "clang14+")+ , ("solver", Explicit "z3")+ ]+ , candidateMatchIdx = 5+ }+ cand2 = CandidateFile { candidateDir = "testdir"+ , candidateSubdirs = []+ , candidateFile = "file.z3.exp"+ , candidatePMatch =+ [ ("solver", Explicit "z3")+ ]+ , candidateMatchIdx = 5+ }+ in do candidateMatchPrefix seps rootPrefix cand1 @? "cand1 pfx match"+ candidateMatchPrefix seps rootPrefix cand2 @? "cand2 pfx match"+ candidateMatchSuffix seps "exp" rootPrefix cand1 @? "cand1 sfx match"+ candidateMatchSuffix seps "exp" rootPrefix cand2 @? "cand2 sfx match" ]