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

🔥 the faulty tests of unbiased branch diffs.

Browse Source
This commit is contained in:
Rob Rix 2016-08-12 12:24:38 -04:00
parent ff4861e2fb
commit 2b35110d0a
1 changed files with 2 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
test/InterpreterSpec.hs
View File

@ -2,7 +2,6 @@
module InterpreterSpec where module InterpreterSpec where
import Category import Category
import Data.Align.Generic
import Data.Functor.Foldable import Data.Functor.Foldable
import Data.RandomWalkSimilarity import Data.RandomWalkSimilarity
import Data.Record import Data.Record
@ -15,7 +14,6 @@ import Syntax
import Term.Arbitrary import Term.Arbitrary
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck import Test.Hspec.QuickCheck
import Test.QuickCheck
spec :: Spec spec :: Spec
spec = parallel $ do spec = parallel $ do
@ -36,20 +34,7 @@ spec = parallel $ do
diff = diffTerms wrap compare diffCost term term in diff = diffTerms wrap compare diffCost term term in
diffCost diff `shouldBe` 0 diffCost diff `shouldBe` 0
let reverse' diff = case runFree diff of
Free (h :< Indexed children) -> wrap (h :< Indexed (reverse children))
Free c -> wrap c
Pure a -> pure a
let toTerm' c (ArbitraryTerm r f) = decorate (toTerm (ArbitraryTerm (setCategory r c) f))
let root = cofree . ((pure 0 .: Program .: RNil) :<) . Indexed
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
stripDiff (diffTerms wrap compare diffCost (root [ a', b' ]) (root [ a' ])) `shouldBe` reverse' (stripDiff (diffTerms wrap compare diffCost (root [ b', a' ]) (root [ a' ])))
prop "produces unbiased insertions" . 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
stripDiff (diffTerms wrap compare diffCost (root [ a' ]) (root [ a', b' ])) `shouldBe` reverse' (stripDiff (diffTerms wrap compare diffCost (root [ a' ]) (root [ b', a' ])))
it "produces unbiased insertions within branches" $ it "produces unbiased insertions within branches" $
let term s = decorate (cofree ((StringLiteral .: RNil) :< Indexed [ cofree ((StringLiteral .: RNil) :< Leaf s) ])) in let term s = decorate (cofree ((StringLiteral .: RNil) :< Indexed [ cofree ((StringLiteral .: RNil) :< Leaf s) ]))
root = cofree . ((pure 0 .: Program .: RNil) :<) . Indexed in
stripDiff (diffTerms wrap compare diffCost (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program .: RNil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ]) stripDiff (diffTerms wrap compare diffCost (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program .: RNil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ])