github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Ensure that the syntaxes are disjoint.

Browse Source
This commit is contained in:
Rob Rix 2016-08-11 13:27:45 -04:00
parent fd23564dd5
commit 70a622ca84
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
test/InterpreterSpec.hs
View File

@ -13,6 +13,7 @@ import Syntax
import Term.Arbitrary
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
spec :: Spec
spec = parallel $ do
@ -39,10 +40,10 @@ spec = parallel $ do
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" $
\ a b c -> let (a', b') = (toTerm' c a, toTerm' c (b :: ArbitraryTerm Text (Record '[Category]))) in
prop "produces unbiased deletions" . forAll (arbitrary `suchThat` \ (a, b, _) -> syntax a /= syntax 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" $
\ a b c -> let (a', b') = (toTerm' c a, toTerm' c (b :: ArbitraryTerm Text (Record '[Category]))) in
prop "produces unbiased insertions" . forAll (arbitrary `suchThat` \ (a, b, _) -> syntax a /= syntax 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' ])))