Merge pull request #421 from maxsnew/test
Test Re-org and Start Property Testing
This commit is contained in:
commit
b0a856eb5f
23 changed files with 213 additions and 24 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -10,3 +10,4 @@ cabal-dev
|
|||
data
|
||||
*/ElmFiles/*
|
||||
.DS_Store
|
||||
*~
|
||||
|
|
39
Elm.cabal
39
Elm.cabal
|
@ -228,6 +228,41 @@ Executable elm-doc
|
|||
|
||||
Test-Suite test-elm
|
||||
Type: exitcode-stdio-1.0
|
||||
Hs-Source-Dirs: tests
|
||||
Hs-Source-Dirs: tests, compiler
|
||||
Main-is: Main.hs
|
||||
build-depends: base, directory, HTF
|
||||
other-modules: Tests.Compiler
|
||||
Tests.Property
|
||||
Tests.Property.Arbitrary
|
||||
SourceSyntax.Helpers
|
||||
SourceSyntax.Literal
|
||||
SourceSyntax.PrettyPrint
|
||||
build-depends: base,
|
||||
directory,
|
||||
Elm,
|
||||
test-framework,
|
||||
test-framework-hunit,
|
||||
test-framework-quickcheck2,
|
||||
HUnit,
|
||||
pretty,
|
||||
QuickCheck >= 2 && < 3,
|
||||
filemanip,
|
||||
aeson,
|
||||
base >=4.2 && <5,
|
||||
binary >= 0.6.4.0,
|
||||
blaze-html == 0.5.* || == 0.6.*,
|
||||
blaze-markup == 0.5.1.*,
|
||||
bytestring,
|
||||
cmdargs,
|
||||
containers >= 0.3,
|
||||
directory,
|
||||
filepath,
|
||||
indents,
|
||||
language-ecmascript >=0.15 && < 1.0,
|
||||
mtl >= 2,
|
||||
pandoc >= 1.10,
|
||||
parsec >= 3.1.1,
|
||||
pretty,
|
||||
text,
|
||||
transformers >= 0.2,
|
||||
union-find,
|
||||
unordered-containers
|
||||
|
|
|
@ -35,7 +35,7 @@ instance Pretty Pattern where
|
|||
PData name ps ->
|
||||
if isTuple name then
|
||||
PP.parens . commaCat $ map pretty ps
|
||||
else sep (PP.text name : map prettyParens ps)
|
||||
else hsep (PP.text name : map prettyParens ps)
|
||||
|
||||
prettyParens pattern = parensIf needsThem (pretty pattern)
|
||||
where
|
||||
|
|
|
@ -1,22 +1,11 @@
|
|||
module Main where
|
||||
|
||||
import System.Directory
|
||||
import System.Exit (exitWith)
|
||||
import System.Environment (getArgs)
|
||||
import Test.Framework.TestManager
|
||||
import Test.Framework.BlackBoxTest
|
||||
import Test.Framework
|
||||
|
||||
import Tests.Compiler
|
||||
import Tests.Property
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
tests <- blackBoxTests "tests" "dist/build/elm/elm" ".elm" bbtArgs
|
||||
code <- runTestWithArgs args tests
|
||||
removeDirectoryRecursive "cache"
|
||||
removeDirectoryRecursive "build"
|
||||
exitWith code
|
||||
|
||||
bbtArgs = defaultBBTArgs { bbtArgs_stdoutDiff = ignoreDiff
|
||||
, bbtArgs_stderrDiff = ignoreDiff }
|
||||
|
||||
ignoreDiff :: Diff
|
||||
ignoreDiff _ _ = return Nothing
|
||||
main = defaultMain [ compilerTests
|
||||
, propertyTests
|
||||
]
|
||||
|
|
38
tests/Tests/Compiler.hs
Normal file
38
tests/Tests/Compiler.hs
Normal file
|
@ -0,0 +1,38 @@
|
|||
module Tests.Compiler (compilerTests)
|
||||
where
|
||||
|
||||
import Data.Functor ((<$>))
|
||||
import Data.Traversable (traverse)
|
||||
import System.FilePath ((</>))
|
||||
import System.FilePath.Find (find, (==?), extension)
|
||||
import Test.Framework
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.HUnit ((@=?), Assertion)
|
||||
|
||||
import Elm.Internal.Utils as Elm
|
||||
|
||||
compilerTests :: Test
|
||||
compilerTests = buildTest $ do
|
||||
goods <- mkTests True =<< getElms "good"
|
||||
bads <- mkTests False =<< getElms "bad"
|
||||
return $ testGroup "Compile Tests"
|
||||
[
|
||||
testGroup "Good Tests" goods
|
||||
, testGroup "Bad Tests" bads
|
||||
]
|
||||
|
||||
where getElms :: FilePath -> IO [FilePath]
|
||||
getElms fname = find (return True) (extension ==? ".elm") (testsDir </> fname)
|
||||
|
||||
mkTests :: Bool -> [FilePath] -> IO [Test]
|
||||
mkTests b = traverse setupTest
|
||||
where setupTest f = testCase f . mkCompileTest b <$> readFile f
|
||||
|
||||
testsDir = "tests" </> "data"
|
||||
|
||||
mkCompileTest :: Bool -- ^ Expect success?
|
||||
-> String -- ^ File Contents
|
||||
-> Assertion
|
||||
mkCompileTest succ modul = noCompileErr @=? succ
|
||||
where noCompileErr = either (const False) (const True) . Elm.compile $ modul
|
||||
expectation = "Compile " ++ if succ then "Success" else "Error"
|
51
tests/Tests/Property.hs
Normal file
51
tests/Tests/Property.hs
Normal file
|
@ -0,0 +1,51 @@
|
|||
module Tests.Property where
|
||||
|
||||
import Control.Applicative ((<*))
|
||||
import Test.Framework
|
||||
import Test.Framework.Providers.HUnit
|
||||
import Test.Framework.Providers.QuickCheck2
|
||||
import Test.HUnit (assert)
|
||||
import Test.QuickCheck
|
||||
import Text.Parsec.Combinator (eof)
|
||||
|
||||
import SourceSyntax.Literal as Lit
|
||||
import SourceSyntax.Pattern as Pat
|
||||
import SourceSyntax.PrettyPrint (Pretty, pretty)
|
||||
import Parse.Helpers (IParser, iParse)
|
||||
import Parse.Literal (literal)
|
||||
import Parse.Pattern (expr)
|
||||
import Tests.Property.Arbitrary
|
||||
|
||||
propertyTests :: Test
|
||||
propertyTests =
|
||||
testGroup "Parse/Print Agreement Tests"
|
||||
[
|
||||
testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)
|
||||
, testProperty "Literal test" $ prop_parse_print literal
|
||||
, testProperty "Pattern test" $ prop_parse_print expr
|
||||
]
|
||||
|
||||
where
|
||||
-- This test was autogenerated from the Pattern test and should be
|
||||
-- left in all its ugly glory.
|
||||
longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')
|
||||
, Pat.PRecord [
|
||||
"q7yclkcm7k_ikstrczv_"
|
||||
, "wQRv6gKsvvkjw4b5F"
|
||||
,"c9'eFfhk9FTvsMnwF_D"
|
||||
,"yqxhEkHvRFwZ"
|
||||
,"o"
|
||||
,"nbUlCn3y3NnkVoxhW"
|
||||
,"iJ0MNy3KZ_lrs"
|
||||
,"ug"
|
||||
,"sHHsX"
|
||||
,"mRKs9d"
|
||||
,"o2KiCX5'ZRzHJfRi8" ]
|
||||
, Pat.PVar "su'BrrbPUK6I33Eq" ]
|
||||
|
||||
prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
|
||||
prop_parse_print p x =
|
||||
either (const False) (== x) . parse_print p $ x
|
||||
|
||||
parse_print :: (Pretty a) => IParser a -> a -> Either String a
|
||||
parse_print p = either (Left . show) (Right) . iParse (p <* eof) . show . pretty
|
75
tests/Tests/Property/Arbitrary.hs
Normal file
75
tests/Tests/Property/Arbitrary.hs
Normal file
|
@ -0,0 +1,75 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Tests.Property.Arbitrary where
|
||||
|
||||
import Control.Applicative ((<$>), (<*>), pure)
|
||||
import Test.QuickCheck.Arbitrary
|
||||
import Test.QuickCheck.Gen
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Parse.Helpers (reserveds)
|
||||
|
||||
import SourceSyntax.Literal
|
||||
import SourceSyntax.Pattern
|
||||
|
||||
instance Arbitrary Literal where
|
||||
arbitrary = oneof [ IntNum <$> arbitrary
|
||||
, FloatNum <$> (arbitrary `suchThat` noE)
|
||||
, Chr <$> arbitrary
|
||||
-- This is too permissive
|
||||
, Str <$> arbitrary
|
||||
-- Booleans aren't actually source syntax
|
||||
-- , Boolean <$> arbitrary
|
||||
]
|
||||
shrink l = case l of
|
||||
IntNum n -> IntNum <$> shrink n
|
||||
FloatNum f -> FloatNum <$> (filter noE . shrink $ f)
|
||||
Chr c -> Chr <$> shrink c
|
||||
Str s -> Str <$> shrink s
|
||||
Boolean b -> Boolean <$> shrink b
|
||||
|
||||
noE :: Double -> Bool
|
||||
noE = notElem 'e' . show
|
||||
|
||||
|
||||
instance Arbitrary Pattern where
|
||||
arbitrary = sized pat
|
||||
where pat :: Int -> Gen Pattern
|
||||
pat n = oneof [ pure PAnything
|
||||
, PVar <$> lowVar
|
||||
, PRecord <$> (listOf1 lowVar)
|
||||
, PLiteral <$> arbitrary
|
||||
, PAlias <$> lowVar <*> pat (n-1)
|
||||
, PData <$> capVar <*> sizedPats
|
||||
]
|
||||
where sizedPats = do
|
||||
len <- choose (0,n)
|
||||
let m = n `div` len in
|
||||
vectorOf len $ pat m
|
||||
|
||||
shrink pat = case pat of
|
||||
PAnything -> []
|
||||
PVar v -> PVar <$> shrinkWHead v
|
||||
PRecord fs -> PRecord <$> (filter (all $ not . null) . filter (not . null) $ shrink fs)
|
||||
PLiteral l -> PLiteral <$> shrink l
|
||||
PAlias s p -> p : (PAlias <$> shrinkWHead s <*> shrink p)
|
||||
PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)
|
||||
where shrinkWHead (x:xs) = (x:) <$> shrink xs
|
||||
|
||||
lowVar :: Gen String
|
||||
lowVar = notReserved $ (:) <$> lower <*> listOf varLetter
|
||||
where lower = elements ['a'..'z']
|
||||
|
||||
capVar :: Gen String
|
||||
capVar = notReserved $ (:) <$> upper <*> listOf varLetter
|
||||
where upper = elements ['A'..'Z']
|
||||
|
||||
varLetter :: Gen Char
|
||||
varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']
|
||||
|
||||
notReserved :: Gen String -> Gen String
|
||||
notReserved = flip exceptFor Parse.Helpers.reserveds
|
||||
|
||||
exceptFor :: (Ord a) => Gen a -> [a] -> Gen a
|
||||
exceptFor g xs = g `suchThat` notAnX
|
||||
where notAnX = flip Set.notMember xset
|
||||
xset = Set.fromList xs
|
Loading…
Reference in a new issue