tasty-sugar-2.2.3.3: test/internals/test-internals.hs
module Main where
import Control.Monad ( unless )
import qualified Data.List as L
import Test.Tasty
import Test.Tasty.HUnit
import Text.Show.Pretty
import Test.Tasty.Sugar.Candidates
import Test.Tasty.Sugar.ExpectCheck
import Test.Tasty.Sugar.ParamCheck
import Test.Tasty.Sugar.Types
main = defaultMain $
let sample =
[
Expectation
{
expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("bar", Explicit "b")
, ("cow", Assumed "moo")
]
, associated = []
}
, Expectation
{
expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("bar", Explicit "b")
, ("cow", Assumed "milk")
]
, associated = []
}
-- KWQ: inverse here, more specific 0th entry supercedes this one
-- , Expectation
-- {
-- expectedFile = "test.file"
-- , expParamsMatch =
-- [ ("foo", Explicit "a")
-- , ("cow", Assumed "moo")
-- ]
-- , associated = []
-- }
, Expectation
{
expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "other")
, ("bar", Explicit "b")
, ("cow", Assumed "moo")
]
, associated = []
}
, Expectation
{
expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Assumed "a")
, ("bar", Explicit "b")
, ("cow", Assumed "moo")
]
, associated = []
}
-- -- KWQ: more specific than the 0th entry, so this supercedes that entry (separate test)
-- , Expectation
-- { expectedFile = "test.file"
-- , expParamsMatch =
-- [ ("foo", Explicit "a")
-- , ("bar", Explicit "b")
-- , ("cow", Assumed "moo")
-- , ("frog", Explicit "croak")
-- ]
-- , associated = []
-- }
]
in testGroup "Expected trimming"
[ testCase "non-explicit removals" $
pCmpExp (init sample)
(collateExpectations sample)
, testCase "supermatch supercedes" $
-- Normally the trimming occurs on Expectations which all have
-- a matching named set of expParamsMatch even though the
-- values may be different. If, however, and Expectation
-- exists which has _more_ params than the rest, it will
-- supercede any Expectation that has the same set but fewer,
-- as this test checks. This test is not critical to overall
-- functionality, but serves to capture behavior.
--
-- Here, "adding" replaces the first element of sample because it
-- otherwise matches sample but has more parameters.
let adding = Expectation
{ expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("bar", Explicit "b")
, ("cow", Assumed "moo")
, ("frog", Explicit "croak")
]
, associated = []
}
test l = pCmpExp ((take 2 $ tail $ init sample)
<> [adding]
<> (drop 3 $ init sample)
)
(collateExpectations l)
in mapM_ test (L.permutations $ adding : sample)
, testCase "submatch removed" $
-- This is the inverse of the supermatch: an entry is added
-- that has fewer params, and it is elided in favor of an entry
-- that has matching params plus additional params.
let adding = Expectation
{
expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("cow", Assumed "moo")
]
, associated = []
}
test l = pCmpExp (init sample) (collateExpectations l)
in mapM_ test (L.permutations $ adding : sample)
, testCase "superset and subset distinct" $
-- As a variation of the supermatch and submatch tests, if an
-- Expectation exists that has a different number of params but
-- the params that are present are not a strict subset, then
-- that is simply treated as a different Expectation than the
-- others and doesn't affect matching removal.
let adding = [ Expectation
{ expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("bar", Explicit "bell")
, ("cow", Assumed "moo")
, ("frog", Explicit "croak")
]
, associated = []
}
, Expectation
{ expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("cow", Explicit "moo")
-- Explicit "moo" here against Assumed "moo" plus two
-- more explicits above... this gets removed. Note
-- also that this matches the first element of
-- sample, but that element and the adding element
-- above are incompatible, so this will be associated
-- with one or the other, but not both.
]
, associated = []
}
]
test l = pCmpExp (take 1 adding <> init sample) (collateExpectations l)
in mapM_ test (L.permutations $ adding <> sample)
, testCase "distinct if different" $
let adding = [ Expectation
{ expectedFile = "test.file"
, expParamsMatch =
[ ("foo", Explicit "a")
, ("bar", Explicit "bell")
, ("cow", Assumed "moo")
]
, associated = []
}
]
test l = pCmpExp (adding <> init sample) (collateExpectations l)
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"
]
pCmpExp expected actual =
unless (expected `elem` L.permutations actual) $
assertFailure $ unlines
["MISMATCH ---vvv---"
,"----- Expected [" <> show (length expected) <> "]:"
, ppShow expected
,"----- Actual [" <> show (length actual) <> "]:"
, ppShow actual
,"MISMATCH ---^^^---"
]