@@ -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+