on master help sign in
added some tests of simple programs with assignment
commit17d90a34a28de96650dd6c51ef237acc190c1f46 authortechtangents <dylan@techtangents.com> dateWed 13 Mar 2013, 23:47 (14 years ago) parentb87f966
5 files changed+115−7
elm/Elm.cabal+2−1 elm/test+7 elm/tests/Main.hs+74−6 elm/tests/Util/CharGens.hs+19 elm/tests/Util/Stringable.hs+13
elm/Elm.cabal+2−1
@@ -148,7 +148,8 @@ test-suite Main
148148
149149 QuickCheck >= 2.4,
150150 test-framework >= 0.4.1,
151− test-framework-quickcheck2
151+ test-framework-quickcheck2,
152+ regex-compat
152153
153154 hs-source-dirs: src, tests
154155 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/tests/Main.hs+74−6
@@ -1,20 +1,88 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
2+
13module Main where
24
5+import Control.Applicative
6+
7+import Data.Maybe (listToMaybe, isJust)
8+import Data.Functor.Identity
9+import Data.Text
10+
311import Test.Framework as TF (defaultMain, testGroup, Test)
412import Test.Framework.Providers.QuickCheck2 (testProperty)
13+import Test.QuickCheck
14+import Test.QuickCheck.Property
15+
16+import Text.Regex
17+
18+import Parse.Parser
19+
20+import Debug.Trace
21+
22+import Util.Stringable
23+import Util.CharGens
524
6−import Data.Maybe (listToMaybe)
7−import Data.Functor.Identity
825
926main :: IO ()
1027main = defaultMain tests
1128
29+parses :: String -> Bool
30+parses code = either (const False) (const True) (parseProgram code)
31+
1232tests :: [TF.Test]
1333tests = [
14− testGroup "The" [
15− testProperty "prop_blah" prop_blah
34+ testGroup "String Assignments" [
35+ testProperty "prop_assignString" prop_assignString,
36+ testProperty "prop_invalidIdent" prop_invalidIdent
1637 ]
1738 ]
1839
19−prop_blah :: Bool -> Bool
20−prop_blah _ = True
40+
41+newtype ValidIdent = ValidIdent String deriving (Eq, Show)
42+
43+instance Stringable ValidIdent where
44+ stringify (ValidIdent v) = v
45+
46+instance Arbitrary ValidIdent where
47+ arbitrary = ValidIdent <$> ((:) <$> lowerAlpha <*> (listOf alphaNumUnderPrime))
48+
49+
50+newtype StringValue = StringValue String deriving (Eq, Show)
51+
52+instance Stringable StringValue where
53+ stringify (StringValue v) = v
54+
55+instance Arbitrary StringValue where
56+ arbitrary = StringValue <$> escape <$> arbitrary
57+
58+
59+newtype InvalidIdentChar = InvalidIdentChar Char deriving (Eq, Show)
60+
61+instance Stringable InvalidIdentChar where
62+ stringify (InvalidIdentChar c) = [c]
63+
64+instance Arbitrary InvalidIdentChar where
65+ arbitrary = InvalidIdentChar <$> elements "!@#$%^&*()-=+\\|/?.>,<`~"
66+
67+
68+replace' :: String -> String -> String -> String
69+replace' a b c = unpack $ replace (pack a) (pack b) (pack c)
70+
71+escape :: String -> String
72+escape =
73+ (replace' "\n" "\\n") .
74+ (replace' "\t" "\\t") .
75+ (replace' "\"" "\\\"") .
76+ (replace' "\\" "\\\\")
77+
78+
79+-- TODO: variable whitespace?
80+prop_assignString :: ValidIdent -> StringValue -> Bool
81+prop_assignString vi sv =
82+ parses $ vi +- " = \"" +- sv +- "\""
83+
84+
85+prop_invalidIdent :: ValidIdent -> InvalidIdentChar -> StringValue -> Bool
86+prop_invalidIdent vi i s =
87+ (not . parses) $ vi +- i +- " = \"" +- s +- "\""
88+
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/Stringable.hsnew file+13
@@ -0,0 +1,13 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
2+
3+module Util.Stringable where
4+
5+class Stringable s where
6+ stringify :: s -> String
7+
8+instance Stringable String where
9+ stringify = id
10+
11+infixr 5 +-
12+(+-) :: (Stringable a, Stringable b) => a -> b -> String
13+a +- b = (stringify a) ++ (stringify b)