@@ -1,20 +1,88 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
1module Main where
3module Main where
5+import Control.Applicative
7+import Data.Maybe (listToMaybe, isJust)
8+import Data.Functor.Identity
3import Test.Framework as TF (defaultMain, testGroup, Test)
11import Test.Framework as TF (defaultMain, testGroup, Test)
4import Test.Framework.Providers.QuickCheck2 (testProperty)
12import Test.Framework.Providers.QuickCheck2 (testProperty)
13+import Test.QuickCheck
14+import Test.QuickCheck.Property
22+import Util.Stringable
6−import Data.Maybe (listToMaybe)
7−import Data.Functor.Identity
9main :: IO ()
26main :: IO ()
10main = defaultMain tests
27main = defaultMain tests
29+parses :: String -> Bool
30+parses code = either (const False) (const True) (parseProgram code)
12tests :: [TF.Test]
32tests :: [TF.Test]
14− testGroup "The" [
34+ testGroup "String Assignments" [
15− testProperty "prop_blah" prop_blah
35+ testProperty "prop_assignString" prop_assignString,
36+ testProperty "prop_invalidIdent" prop_invalidIdent
19−prop_blah :: Bool -> Bool
40+
20−prop_blah _ = True
41+newtype ValidIdent = ValidIdent String deriving (Eq, Show)
43+instance Stringable ValidIdent where
44+ stringify (ValidIdent v) = v
46+instance Arbitrary ValidIdent where
47+ arbitrary = ValidIdent <$> ((:) <$> lowerAlpha <*> (listOf alphaNumUnderPrime))
50+newtype StringValue = StringValue String deriving (Eq, Show)
52+instance Stringable StringValue where
53+ stringify (StringValue v) = v
55+instance Arbitrary StringValue where
56+ arbitrary = StringValue <$> escape <$> arbitrary
59+newtype InvalidIdentChar = InvalidIdentChar Char deriving (Eq, Show)
61+instance Stringable InvalidIdentChar where
62+ stringify (InvalidIdentChar c) = [c]
64+instance Arbitrary InvalidIdentChar where
65+ arbitrary = InvalidIdentChar <$> elements "!@#$%^&*()-=+\\|/?.>,<`~"
68+replace' :: String -> String -> String -> String
69+replace' a b c = unpack $ replace (pack a) (pack b) (pack c)
71+escape :: String -> String
73+ (replace' "\n" "\\n") .
74+ (replace' "\t" "\\t") .
75+ (replace' "\"" "\\\"") .
76+ (replace' "\\" "\\\\")
79+-- TODO: variable whitespace?
80+prop_assignString :: ValidIdent -> StringValue -> Bool
81+prop_assignString vi sv =
82+ parses $ vi +- " = \"" +- sv +- "\""
85+prop_invalidIdent :: ValidIdent -> InvalidIdentChar -> StringValue -> Bool
86+prop_invalidIdent vi i s =
87+ (not . parses) $ vi +- i +- " = \"" +- s +- "\""