git.iko.soy/elk
on master help sign in
Merge pull request #119 from techtangents/quickcheck

Quickcheck

commit95758d2e315a133b9590f5a35d6b8828bf2c7d53 authorEvan Czaplicki <info@elm-lang.org> dateSun 17 Mar 2013, 17:46 (14 years ago) parent764c77e98d7fde
8 files changed+180−1
compare with master
unifiedsplit
elm/Elm.cabal+32−1 elm/test+7 elm/testRepl+5 elm/tests/.ghci+5 elm/tests/Main.hs+54 elm/tests/Util/Arbs.hs+45 elm/tests/Util/CharGens.hs+19 elm/tests/Util/String.hs+13
elm/Elm.cabal+32−1
@@ -122,4 +122,35 @@ Executable elm
122122 bytestring,
123123 hjsmin,
124124 indents,
125− filepath
125+ filepath
126+
127+
128+test-suite Main
129+ type: exitcode-stdio-1.0
130+ x-uses-tf: true
131+
132+ build-depends: base >=4.2 && <5,
133+ containers >= 0.3,
134+ transformers >= 0.2,
135+ mtl >= 2,
136+ parsec >= 3.1.1,
137+ blaze-html == 0.5.*,
138+ blaze-markup == 0.5.1.*,
139+ deepseq,
140+ text,
141+ template-haskell,
142+ shakespeare >= 1,
143+ pandoc >= 1.10,
144+ bytestring,
145+ hjsmin,
146+ indents,
147+ filepath,
148+
149+ QuickCheck >= 2.4,
150+ test-framework >= 0.4.1,
151+ test-framework-quickcheck2,
152+ regex-compat,
153+ interpolatedstring-perl6 >= 0.9
154+
155+ hs-source-dirs: src, tests
156+ main-is: Main.hs
elm/testnew file+7
@@ -0,0 +1,7 @@
1+#!/bin/sh
2+(
3+ cd `dirname $0` &&
4+ cabal configure --enable-tests &&
5+ cabal build &&
6+ cabal test
7+) || exit 1
elm/testReplnew file+5
@@ -0,0 +1,5 @@
1+#!/bin/sh
2+
3+here=`cd \`dirname $0\` && pwd`
4+cd "$here/tests" &&
5+ghci
elm/tests/.ghcinew file+5
@@ -0,0 +1,5 @@
1+:set -i../src -i.
2+:l Main Parse.Parser
3+:m + Test.QuickCheck Main
4+:set prompt "test>> "
5+:set -Wall
elm/tests/Main.hsnew file+54
@@ -0,0 +1,54 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, QuasiQuotes, ExtendedDefaultRules #-}
2+
3+
4+module Main where
5+
6+import Test.Framework as TF (defaultMain, testGroup, Test)
7+import Test.Framework.Providers.QuickCheck2 (testProperty)
8+
9+import Text.InterpolatedString.Perl6 (qq)
10+import Parse.Parser
11+import Util.Arbs
12+
13+import Debug.Trace
14+
15+main :: IO ()
16+main = defaultMain tests
17+
18+parses :: String -> Bool
19+parses code = either (const False) (const True) (parseProgram code)
20+
21+parseFails :: String -> Bool
22+parseFails = not . parses
23+
24+tests :: [TF.Test]
25+tests = [
26+ testGroup "String Assignments" [
27+ testProperty "prop_assignString" prop_assignString
28+ , testProperty "prop_invalidIdent" prop_invalidIdent
29+ , testProperty "prop_emptyList" prop_emptyList
30+ , testProperty "prop_record" prop_record
31+ ]
32+ ]
33+
34+prop_assignString :: ValidIdent -> StringLiteral -> Bool
35+prop_assignString i s = parses [qq|
36+{i} = {s}
37+|]
38+
39+prop_invalidIdent :: ValidIdent -> InvalidIdentChar -> StringLiteral -> Bool
40+prop_invalidIdent i z s = parseFails [qq|
41+{i}{z} = {s}
42+|]
43+
44+prop_emptyList :: ValidIdent -> Bool
45+prop_emptyList i = parses [qq|
46+{i}=[]
47+|]
48+
49+prop_record :: ValidIdent -> ValidIdent -> ValidIdent -> ValidIdent -> StringLiteral -> Bool
50+prop_record a b c k v = parses [qq|
51+{a} = \{{k} = {v} \}
52+{b} = .{k} {a}
53+{c} = {a}.{k}
54+|]
elm/tests/Util/Arbs.hsnew file+45
@@ -0,0 +1,45 @@
1+module Util.Arbs where
2+
3+import Control.Applicative
4+import Test.QuickCheck
5+import Util.CharGens
6+import Util.String
7+
8+import Text.InterpolatedString.Perl6 (ShowQ(showQ))
9+
10+
11+newtype ValidIdent = ValidIdent String deriving (Eq, Show)
12+
13+instance ShowQ ValidIdent where
14+ showQ (ValidIdent v) = v
15+
16+instance Arbitrary ValidIdent where
17+ arbitrary = ValidIdent <$> ((:) <$> lowerAlpha <*> (listOf alphaNumUnderPrime))
18+
19+
20+newtype StringLiteral = StringLiteral String deriving (Eq, Show)
21+
22+instance ShowQ StringLiteral where
23+ showQ (StringLiteral v) = v
24+
25+instance Arbitrary StringLiteral where
26+ arbitrary = StringLiteral <$> (\x -> "\"" ++ x ++ "\"") <$> escape <$> arbitrary
27+
28+
29+newtype InvalidIdentChar = InvalidIdentChar Char deriving (Eq, Show)
30+
31+instance ShowQ InvalidIdentChar where
32+ showQ (InvalidIdentChar c) = [c]
33+
34+instance Arbitrary InvalidIdentChar where
35+ arbitrary = InvalidIdentChar <$> elements "!@#$%^&*()-=+\\|/?.>,<`~"
36+
37+
38+newtype BuiltinType = BuiltinType String deriving (Eq, Show)
39+
40+instance ShowQ BuiltinType where
41+ showQ (BuiltinType v) = v
42+
43+instance Arbitrary BuiltinType where
44+ -- TODO: add others
45+ arbitrary = BuiltinType <$> elements ["Char", "String"]
elm/tests/Util/CharGens.hsnew file+19
@@ -0,0 +1,19 @@
1+module Util.CharGens where
2+
3+import Test.QuickCheck
4+import Test.QuickCheck.Property
5+
6+lowerAlpha :: Gen Char
7+lowerAlpha = elements ['a'..'z']
8+
9+upperAlpha :: Gen Char
10+upperAlpha = elements ['A'..'Z']
11+
12+alpha :: Gen Char
13+alpha = oneof [lowerAlpha, upperAlpha]
14+
15+alphaNum :: Gen Char
16+alphaNum = oneof [alpha, elements ['0'..'9']]
17+
18+alphaNumUnderPrime :: Gen Char
19+alphaNumUnderPrime = oneof [alphaNum, elements ['_', '\'']]
elm/tests/Util/String.hsnew file+13
@@ -0,0 +1,13 @@
1+module Util.String where
2+
3+import qualified Data.Text as T
4+
5+replace :: String -> String -> String -> String
6+replace a b c = T.unpack (T.replace (T.pack a) (T.pack b) (T.pack c))
7+
8+escape :: String -> String
9+escape =
10+ (replace "\n" "\\n") .
11+ (replace "\t" "\\t") .
12+ (replace "\"" "\\\"") .
13+ (replace "\\" "\\\\")