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
|
data
|
||||||
*/ElmFiles/*
|
*/ElmFiles/*
|
||||||
.DS_Store
|
.DS_Store
|
||||||
|
*~
|
||||||
|
|
39
Elm.cabal
39
Elm.cabal
|
@ -228,6 +228,41 @@ Executable elm-doc
|
||||||
|
|
||||||
Test-Suite test-elm
|
Test-Suite test-elm
|
||||||
Type: exitcode-stdio-1.0
|
Type: exitcode-stdio-1.0
|
||||||
Hs-Source-Dirs: tests
|
Hs-Source-Dirs: tests, compiler
|
||||||
Main-is: Main.hs
|
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
|
||||||
|
|
|
@ -8,7 +8,7 @@ data Literal = IntNum Int
|
||||||
| Chr Char
|
| Chr Char
|
||||||
| Str String
|
| Str String
|
||||||
| Boolean Bool
|
| Boolean Bool
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Pretty Literal where
|
instance Pretty Literal where
|
||||||
pretty literal =
|
pretty literal =
|
||||||
|
@ -17,4 +17,4 @@ instance Pretty Literal where
|
||||||
FloatNum n -> PP.double n
|
FloatNum n -> PP.double n
|
||||||
Chr c -> PP.quotes (PP.char c)
|
Chr c -> PP.quotes (PP.char c)
|
||||||
Str s -> PP.text (show s)
|
Str s -> PP.text (show s)
|
||||||
Boolean bool -> PP.text (show bool)
|
Boolean bool -> PP.text (show bool)
|
||||||
|
|
|
@ -35,7 +35,7 @@ instance Pretty Pattern where
|
||||||
PData name ps ->
|
PData name ps ->
|
||||||
if isTuple name then
|
if isTuple name then
|
||||||
PP.parens . commaCat $ map pretty ps
|
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)
|
prettyParens pattern = parensIf needsThem (pretty pattern)
|
||||||
where
|
where
|
||||||
|
@ -43,4 +43,4 @@ prettyParens pattern = parensIf needsThem (pretty pattern)
|
||||||
case pattern of
|
case pattern of
|
||||||
PData name (_:_) | not (isTuple name) -> True
|
PData name (_:_) | not (isTuple name) -> True
|
||||||
PAlias _ _ -> True
|
PAlias _ _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
|
@ -1,22 +1,11 @@
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import System.Directory
|
import Test.Framework
|
||||||
import System.Exit (exitWith)
|
|
||||||
import System.Environment (getArgs)
|
import Tests.Compiler
|
||||||
import Test.Framework.TestManager
|
import Tests.Property
|
||||||
import Test.Framework.BlackBoxTest
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = defaultMain [ compilerTests
|
||||||
args <- getArgs
|
, propertyTests
|
||||||
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
|
|
||||||
|
|
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