github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +03:00
Code Issues Projects Releases Wiki Activity

Test that Interpreter produces correct diffs.

Browse Source
This commit is contained in:
Rob Rix 2016-06-27 15:28:11 -04:00
parent 2de9468ed1
commit b8ba07522b
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
test/InterpreterSpec.hs
View File

@ -1,13 +1,17 @@
{-# LANGUAGE DataKinds #-}
module InterpreterSpec where module InterpreterSpec where
import Category import Category
import Diff import Diff
import Data.Record import Data.Record
import Data.Record.Arbitrary ()
import Interpreter import Interpreter
import Patch import Patch
import Prologue import Prologue
import Syntax import Syntax
import Term.Arbitrary
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck
spec :: Spec spec :: Spec
spec = parallel $ do spec = parallel $ do
@ -16,3 +20,7 @@ spec = parallel $ do
let termA = cofree $ (StringLiteral .: RNil) :< Leaf "t\776" let termA = cofree $ (StringLiteral .: RNil) :< Leaf "t\776"
termB = cofree $ (StringLiteral .: RNil) :< Leaf "\7831" in termB = cofree $ (StringLiteral .: RNil) :< Leaf "\7831" in
diffTerms (free . Free) ((==) `on` extract) diffCost termA termB `shouldBe` free (Pure (Replace termA termB)) diffTerms (free . Free) ((==) `on` extract) diffCost termA termB `shouldBe` free (Pure (Replace termA termB))
prop "produces correct diffs" $
\ a b -> let diff = diffTerms (free . Free) ((==) `on` extract) diffCost (toTerm a) (toTerm b) :: Diff Text (Record '[Category]) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (toTerm a), Just (toTerm b))