diff --git a/.gitignore b/.gitignore index a502b8e..d096822 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ cabal-dev data */ElmFiles/* .DS_Store +*~ diff --git a/Elm.cabal b/Elm.cabal index cd796be..86ad2a7 100644 --- a/Elm.cabal +++ b/Elm.cabal @@ -228,12 +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 + 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, - filemanip + 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 diff --git a/compiler/SourceSyntax/Literal.hs b/compiler/SourceSyntax/Literal.hs index a7bdb9d..1fe0577 100644 --- a/compiler/SourceSyntax/Literal.hs +++ b/compiler/SourceSyntax/Literal.hs @@ -8,7 +8,7 @@ data Literal = IntNum Int | Chr Char | Str String | Boolean Bool - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show) instance Pretty Literal where pretty literal = @@ -17,4 +17,4 @@ instance Pretty Literal where FloatNum n -> PP.double n Chr c -> PP.quotes (PP.char c) Str s -> PP.text (show s) - Boolean bool -> PP.text (show bool) \ No newline at end of file + Boolean bool -> PP.text (show bool) diff --git a/tests/Main.hs b/tests/Main.hs index 13547b3..72c3021 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -3,6 +3,9 @@ module Main where import Test.Framework import Tests.Compiler +import Tests.Property main :: IO () -main = defaultMain [ compilerTests ] +main = defaultMain [ compilerTests + , propertyTests + ] diff --git a/tests/Tests/Property.hs b/tests/Tests/Property.hs new file mode 100644 index 0000000..ee036c5 --- /dev/null +++ b/tests/Tests/Property.hs @@ -0,0 +1,22 @@ +module Tests.Property where + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 +import Test.QuickCheck + +import SourceSyntax.Literal (Literal) +import SourceSyntax.PrettyPrint (pretty) +import Parse.Helpers (iParse) +import Parse.Literal (literal) +import Tests.Property.Arbitrary + +propertyTests :: Test +propertyTests = + testGroup "Parse/Print Agreement Tests" + [ + testProperty "Literal test" prop_literal_parse_print + ] + +prop_literal_parse_print :: Literal -> Bool +prop_literal_parse_print l = + either (const False) (== l) . iParse literal . show . pretty $ l diff --git a/tests/Tests/Property/Arbitrary.hs b/tests/Tests/Property/Arbitrary.hs new file mode 100644 index 0000000..c5fa1e4 --- /dev/null +++ b/tests/Tests/Property/Arbitrary.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Tests.Property.Arbitrary where + +import Control.Applicative ((<$>)) +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Gen + +import SourceSyntax.Literal + +instance Arbitrary Literal where + arbitrary = oneof [ IntNum <$> arbitrary + , FloatNum <$> arbitrary + , Chr <$> arbitrary + , Str <$> arbitrary + -- Booleans aren't actually source syntax + -- , Boolean <$> arbitrary + ] + shrink l = case l of + IntNum n -> IntNum <$> shrink n + FloatNum f -> FloatNum <$> shrink f + Chr c -> Chr <$> shrink c + Str s -> Str <$> shrink s + Boolean b -> Boolean <$> shrink b