1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Fix the tests.

This commit is contained in:
Rob Rix 2019-07-29 11:18:19 -04:00
parent e9b21f6ebf
commit e2db378be6
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
3 changed files with 22 additions and 19 deletions

View File

@ -84,6 +84,7 @@ test-suite spec
other-modules: Generators
build-depends: base
, semantic-core
, fused-effects
, hedgehog ^>= 1
, tasty >= 1.2 && <2
, tasty-hedgehog ^>= 1.0.0.1

View File

@ -1,4 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}
module Generators
( literal
@ -18,6 +18,7 @@ import Hedgehog hiding (Var)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Control.Effect.Sum ((:+:))
import qualified Data.Core as Core
import Data.Name
import Data.Term
@ -29,16 +30,16 @@ name :: MonadGen m => m (Named User)
name = Gen.prune (named' <$> names) where
names = Gen.text (Range.linear 1 10) Gen.lower
boolean :: MonadGen m => m (Term Core.Core User)
boolean :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
boolean = Core.bool <$> Gen.bool
variable :: MonadGen m => m (Term Core.Core User)
variable :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
variable = pure . namedValue <$> name
ifthenelse :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
ifthenelse :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
apply :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
apply :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
apply gen = go where
go = Gen.recursive
Gen.choice
@ -47,21 +48,21 @@ apply gen = go where
, Gen.subtermM go (\x -> Core.lam <$> name <*> pure x)
]
lambda :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
lambda :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
lambda bod = do
arg <- name
Gen.subterm bod (Core.lam arg)
record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
record :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User) -> m (Term (Core.Ann :+: Core.Core) User)
record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
atoms :: MonadGen m => [m (Term Core.Core User)]
atoms :: MonadGen m => [m (Term (Core.Ann :+: Core.Core) User)]
atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
literal :: MonadGen m => m (Term Core.Core User)
literal :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
expr :: MonadGen m => m (Term Core.Core User)
expr :: MonadGen m => m (Term (Core.Ann :+: Core.Core) User)
expr = Gen.recursive Gen.choice atoms
[ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
, Gen.subterm2 expr expr (Core.>>>)

View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings, TypeOperators #-}
module Main (main) where
import Data.String
@ -9,6 +9,7 @@ import Test.Tasty
import Test.Tasty.Hedgehog
import Test.Tasty.HUnit
import Control.Effect.Sum
import Data.File
import qualified Generators as Gen
import qualified Analysis.Eval as Eval
@ -20,7 +21,7 @@ import Data.Term
-- * Helpers
true, false :: Term Core User
true, false :: Term (Ann :+: Core) User
true = bool True
false = bool False
@ -30,10 +31,10 @@ parseEither p = Trifecta.foldResult (Left . show . Trifecta._errDoc) Right . Tri
-- * Parser roundtripping properties. Note that parsing and prettyprinting is generally
-- not a roundtrip, because the parser inserts 'Ann' nodes itself.
prop_roundtrips :: Gen (Term Core User) -> Property
prop_roundtrips :: Gen (Term (Ann :+: Core) User) -> Property
prop_roundtrips gen = property $ do
input <- forAll gen
tripping input showCore (parseEither (Parse.core <* Trifecta.eof))
tripping input (showCore . stripAnnotations) (parseEither (Parse.core <* Trifecta.eof))
parserProps :: TestTree
parserProps = testGroup "Parsing: roundtripping"
@ -46,7 +47,7 @@ parserProps = testGroup "Parsing: roundtripping"
-- * Parser specs
parsesInto :: String -> Term Core User -> Assertion
parsesInto :: String -> Term (Ann :+: Core) User -> Assertion
parsesInto str res = case parseEither Parse.core str of
Right x -> x @?= res
Left m -> assertFailure m
@ -56,7 +57,7 @@ assert_booleans_parse = do
parseEither Parse.core "#true" @?= Right true
parseEither Parse.core "#false" @?= Right false
a, f, g, h :: Term Core User
a, f, g, h :: Term (Ann :+: Core) User
(a, f, g, h) = (pure "a", pure "f", pure "g", pure "h")
assert_ifthen_parse :: Assertion
@ -92,9 +93,9 @@ parserSpecs = testGroup "Parsing: simple specs"
, testCase "quoted names" assert_quoted_name_parse
]
assert_roundtrips :: File (Term Core User) -> Assertion
assert_roundtrips (File _ core) = case parseEither Parse.core (showCore core) of
Right v -> v @?= stripAnnotations core
assert_roundtrips :: File (Term (Ann :+: Core) User) -> Assertion
assert_roundtrips (File _ core) = case parseEither Parse.core (showCore (stripAnnotations core)) of
Right v -> stripAnnotations v @?= stripAnnotations core
Left e -> assertFailure e
parserExamples :: TestTree