github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Add a concrete test of unbiased deletions.

Browse Source
This commit is contained in:
Rob Rix 2016-08-12 11:40:30 -04:00
parent 842ff553c1
commit fa983e5561
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
test/Data/RandomWalkSimilarity/Spec.hs
View File

@ -31,7 +31,8 @@ spec = parallel $ do
describe "rws" $ do
let compare a b = if ((==) `on` category . extract) a b then Just (replacing a b) else Nothing
let toTerm' = featureVectorDecorator (category . headF) 2 2 15 . toTerm
let decorate = featureVectorDecorator (category . headF) 2 2 15
let toTerm' = decorate . toTerm
prop "produces correct diffs" . forAll (scale (`div` 4) arbitrary) $
\ (as, bs) -> let tas = toTerm' <$> (as :: [ArbitraryTerm Text (Record '[Category])])
tbs = toTerm' <$> (bs :: [ArbitraryTerm Text (Record '[Category])])
@ -40,6 +41,10 @@ spec = parallel $ do
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
let toTerm'' c (ArbitraryTerm r f) = toTerm' (ArbitraryTerm (setCategory r c) f)
it "produces unbiased deletions" $
let (a, b) = (decorate (cofree ((StringLiteral .: RNil) :< Leaf "a")), decorate (cofree ((StringLiteral .: RNil) :< Leaf "b"))) in
fmap stripDiff (rws compare [ a, b ] [ b ]) `shouldBe` fmap stripDiff [ deleting a, replacing b b ]
prop "produces unbiased deletions" . forAll (arbitrary `suchThat` \ (a, b, _) -> isNothing ((galign `on` syntax) a b)) $
\ (a, b, c) -> let (a', b') = (toTerm'' c a, toTerm'' c (b :: ArbitraryTerm Text (Record '[Category]))) in
fmap stripDiff (rws compare [ a', b' ] [ a' ]) `shouldBe` fmap stripDiff (reverse (rws compare [ b', a' ] [ a' ]))