clean up/basic tests
This commit is contained in:
parent
27ee85ae28
commit
319f682d4a
11
src/State.hs
11
src/State.hs
@ -23,7 +23,7 @@ data Gene
|
|||||||
| GeneVectorBool [Bool]
|
| GeneVectorBool [Bool]
|
||||||
| GeneVectorString [String]
|
| GeneVectorString [String]
|
||||||
| GeneVectorChar [Char]
|
| GeneVectorChar [Char]
|
||||||
| StateFunc (State -> State)
|
| StateFunc (State -> State, String) -- The string stores the name of the function
|
||||||
| PlaceInput String
|
| PlaceInput String
|
||||||
| Close
|
| Close
|
||||||
| Block [Gene]
|
| Block [Gene]
|
||||||
@ -42,7 +42,7 @@ instance Eq Gene where
|
|||||||
GeneVectorString xs == GeneVectorString ys = xs == ys
|
GeneVectorString xs == GeneVectorString ys = xs == ys
|
||||||
GeneVectorChar xs == GeneVectorChar ys = xs == ys
|
GeneVectorChar xs == GeneVectorChar ys = xs == ys
|
||||||
Close == Close = True
|
Close == Close = True
|
||||||
StateFunc _ == StateFunc _ = True -- This line is probably not the best thing to do
|
StateFunc (_, nameX) == StateFunc (_, nameY) = nameX == nameY
|
||||||
Block x == Block y = x == y
|
Block x == Block y = x == y
|
||||||
_ == _ = False
|
_ == _ = False
|
||||||
|
|
||||||
@ -52,7 +52,7 @@ instance Show Gene where
|
|||||||
show (GeneBool x) = "Bool: " <> show x
|
show (GeneBool x) = "Bool: " <> show x
|
||||||
show (GeneString x) = "String: " <> x
|
show (GeneString x) = "String: " <> x
|
||||||
show (GeneChar x) = "Char: " <> show x
|
show (GeneChar x) = "Char: " <> show x
|
||||||
show (StateFunc x) = "Func: " <> show x
|
show (StateFunc (_, funcName)) = "Func: " <> funcName
|
||||||
show (PlaceInput x) = "In: " <> show x
|
show (PlaceInput x) = "In: " <> show x
|
||||||
show (GeneVectorInt xs) = "Int Vec: " <> show xs
|
show (GeneVectorInt xs) = "Int Vec: " <> show xs
|
||||||
show (GeneVectorFloat xs) = "Float Vec: " <> show xs
|
show (GeneVectorFloat xs) = "Float Vec: " <> show xs
|
||||||
@ -101,10 +101,6 @@ data State = State
|
|||||||
}
|
}
|
||||||
deriving (Show, Eq, Generic)
|
deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
-- This needs to be updated later
|
|
||||||
instance Show (State -> State) where
|
|
||||||
show _ = "unnamed"
|
|
||||||
|
|
||||||
instance Arbitrary State where
|
instance Arbitrary State where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
arbExec <- arbitrary
|
arbExec <- arbitrary
|
||||||
@ -122,7 +118,6 @@ instance Arbitrary State where
|
|||||||
arbParameter <- arbitrary
|
arbParameter <- arbitrary
|
||||||
-- arbInput <- arbitrary
|
-- arbInput <- arbitrary
|
||||||
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
||||||
|
|
||||||
-- Thanks hlint lol
|
-- Thanks hlint lol
|
||||||
|
|
||||||
instance CoArbitrary State
|
instance CoArbitrary State
|
||||||
|
@ -16,9 +16,16 @@ myArgs =
|
|||||||
|
|
||||||
-- quickCheckWith myArgs prop_IntAdd
|
-- quickCheckWith myArgs prop_IntAdd
|
||||||
|
|
||||||
|
-- These two used for ghci testing
|
||||||
|
qcw :: Testable a => a-> IO ()
|
||||||
|
qcw = quickCheckWith myArgs
|
||||||
|
|
||||||
|
vcw :: Testable a => a-> IO ()
|
||||||
|
vcw = verboseCheckWith myArgs
|
||||||
|
|
||||||
-- Running this with a large max size leads quickCheck to hang, and that's bad
|
-- Running this with a large max size leads quickCheck to hang, and that's bad
|
||||||
prop_IntAdd :: State -> Bool
|
prop_IntAdd :: State -> Bool
|
||||||
prop_IntAdd state@(State {_int = i1 : i2 : is}) = i1 + i2 == head (_int (instructionIntAdd state))
|
prop_IntAdd state@(State {_int = i1 : i2 : _}) = i1 + i2 == head (_int (instructionIntAdd state))
|
||||||
prop_IntAdd state = state == instructionIntAdd state
|
prop_IntAdd state = state == instructionIntAdd state
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
Loading…
x
Reference in New Issue
Block a user