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

Migrate the RWS tests to à la carte syntax.

Browse Source
This commit is contained in:
Rob Rix 2017-09-26 09:44:42 -04:00
parent d54f8b34c2
commit c9e4968d93
1 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,49 +1,61 @@
{-# LANGUAGE DataKinds #-}
module Data.RandomWalkSimilarity.Spec where
import Category
import Data.Array.IArray
import Data.Bifunctor
import Data.Functor.Listable ()
import Data.Record
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Comment as Comment
import qualified Data.Syntax.Declaration as Declaration
import qualified Data.Syntax.Statement as Statement
import Data.These
import Data.Union
import Decorators
import Diff
import Info
import Interpreter
import RWS
import Syntax
import Term
import Test.Hspec
import Test.Hspec.LeanCheck
type Syntax = Union
'[ Comment.Comment
, Declaration.Function
, Declaration.Method
, Statement.If
, Syntax.Context
, Syntax.Empty
, Syntax.Identifier
, []
]
spec :: Spec
spec = parallel $ do
let positively = succ . abs
describe "pqGramDecorator" $ do
prop "produces grams with stems of the specified length" $
\ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
\ (term, p, q) -> pqGramDecorator constructorNameAndConstantFields (positively p) (positively q) (term :: Term Syntax (Record '[])) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
prop "produces grams with bases of the specified width" $
\ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== positively q) . length . base . rhead)
\ (term, p, q) -> pqGramDecorator constructorNameAndConstantFields (positively p) (positively q) (term :: Term Syntax (Record '[])) `shouldSatisfy` all ((== positively q) . length . base . rhead)
describe "featureVectorDecorator" $ do
prop "produces a vector of the specified dimension" $
\ (term, p, q, d) -> featureVectorDecorator (rhead . termAnnotation) (positively p) (positively q) (positively d) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== (0, abs d)) . bounds . unFV . rhead)
\ term p q d -> featureVectorDecorator constructorNameAndConstantFields (positively p) (positively q) (positively d) (term :: Term Syntax (Record '[])) `shouldSatisfy` all ((== (0, abs d)) . bounds . unFV . rhead)
describe "rws" $ do
prop "produces correct diffs" $
\ (as, bs) -> let tas = decorate <$> (as :: [Term Syntax (Record '[Category])])
tbs = decorate <$> (bs :: [Term Syntax (Record '[Category])])
root = termIn (Program :. Nil) . Indexed
diff = merge ((Program :. Nil, Program :. Nil)) (Indexed (stripDiff . diffThese <$> rws canCompare (equalTerms canCompare) tas tbs)) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
\ (as, bs) -> let tas = decorate <$> (as :: [Term Syntax (Record '[])])
tbs = decorate <$> (bs :: [Term Syntax (Record '[])])
wrap = termIn Nil . inj
diff = merge (Nil, Nil) (inj (stripDiff . diffThese <$> rws comparableByConstructor (equalTerms comparableByConstructor) tas tbs)) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (wrap (stripTerm <$> tas)), Just (wrap (stripTerm <$> tbs)))
it "produces unbiased insertions within branches" $
let (a, b) = (decorate (Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf "a") ])), decorate (Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf "b") ]))) in
fmap (bimap stripTerm stripTerm) (rws canCompare (equalTerms canCompare) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
let (a, b) = (decorate (termIn Nil (inj [ termIn Nil (inj (Syntax.Identifier "a")) ])), decorate (termIn Nil (inj [ termIn Nil (inj (Syntax.Identifier "b")) ]))) in
fmap (bimap stripTerm stripTerm) (rws comparableByConstructor (equalTerms comparableByConstructor) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
where canCompare a b = termAnnotation a == termAnnotation b
decorate :: Term Syntax (Record '[Category]) -> Term Syntax (Record '[FeatureVector, Category])
decorate = defaultFeatureVectorDecorator (category . termAnnotation)
where decorate = defaultFeatureVectorDecorator constructorNameAndConstantFields
diffThese = these deleting inserting replacing