more instructions and start of int tests
This commit is contained in:
parent
95786d0c93
commit
0fd2c2e5dd
@ -67,6 +67,12 @@ instructionFloatMod :: State -> State
|
||||
instructionFloatMod state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 `mod'` f1 : fs else f1 : f2 : fs}
|
||||
instructionFloatMod state = state
|
||||
|
||||
-- |Mods the second float from the first float and pushes the result to the float stack.
|
||||
-- This does truncate.
|
||||
instructionFloatModOpp :: State -> State
|
||||
instructionFloatModOpp state@(State {_float = f1 : f2 : fs}) = state {_float = if f2 /= 0 then (f1 `mod'` f2) : fs else f1 : f2 : fs}
|
||||
instructionFloatModOpp state = state
|
||||
|
||||
-- |Takes the top two floats from the float stack and pushes the minimum of the two back on top.
|
||||
instructionFloatMin :: State -> State
|
||||
instructionFloatMin state@(State {_float = f1 : f2 : fs}) = state {_float = min f1 f2 : fs}
|
||||
|
||||
@ -135,7 +135,7 @@ instructionShoveDup _ state = state
|
||||
-- |Moves an item from the top of a lens' stack to deep within the lens' stack based on
|
||||
-- the top int from the int stack.
|
||||
instructionShove :: Lens' State [a] -> State -> State
|
||||
instructionShove accessor state = instructionShoveDup accessor state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state ))
|
||||
instructionShove accessor state = state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state ))
|
||||
|
||||
-- |Concats two semigroupable items together based on a lens. Not char generic.
|
||||
instructionVectorConcat :: Semigroup a => Lens' State [a] -> State -> State
|
||||
|
||||
@ -61,12 +61,18 @@ instructionIntDivOpp :: State -> State
|
||||
instructionIntDivOpp state@(State {_int = i1 : i2 : is}) = state {_int = if i2 /= 0 then (i1 `div` i2) : is else i1 : i2 : is}
|
||||
instructionIntDivOpp state = state
|
||||
|
||||
-- |Mods the first float from the second float and pushes the result to the int stack.
|
||||
-- |Mods the first int from the second int and pushes the result to the int stack.
|
||||
-- This does truncate.
|
||||
instructionIntMod :: State -> State
|
||||
instructionIntMod state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `mod` i1) : is else i1 : i2 : is}
|
||||
instructionIntMod state = state
|
||||
|
||||
-- |Mods the second int from the first int and pushes the result to the int stack.
|
||||
-- This does truncate.
|
||||
instructionIntModOpp :: State -> State
|
||||
instructionIntModOpp state@(State {_int = i1 : i2 : is}) = state {_int = if i2 /= 0 then (i1 `mod` i2) : is else i1 : i2 : is}
|
||||
instructionIntModOpp state = state
|
||||
|
||||
-- |Takes the top two ints from the int stack and pushes the minimum of the two back on top.
|
||||
instructionIntMin :: State -> State
|
||||
instructionIntMin state@(State {_int = i1 : i2 : is}) = state {_int = min i1 i2 : is}
|
||||
|
||||
@ -1,9 +1,8 @@
|
||||
module HushGP.PushTests.GenericTests where
|
||||
|
||||
-- import HushGP.State
|
||||
-- import Control.Lens
|
||||
-- -- import Debug.Trace
|
||||
-- import Test.QuickCheck
|
||||
import HushGP.State
|
||||
import Control.Lens
|
||||
import Test.Tasty.QuickCheck
|
||||
-- -- import HushGP.Instructions.GenericInstructions
|
||||
|
||||
-- -- The naming scheme:
|
||||
@ -15,11 +14,14 @@ module HushGP.PushTests.GenericTests where
|
||||
-- -- We may be able to get rid of Lens entirely and use haskell's integrated accessors of type State -> [a]
|
||||
-- -- You can see what I'm talking about if you go into ghci and type: `:info _int` for example
|
||||
|
||||
-- aaa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a -> a) -> State -> Property
|
||||
-- aaa1Test accessor instruction transformation state =
|
||||
-- case (uncons (view accessor state), uncons (view accessor $ instruction state)) of
|
||||
-- (Just (origx1, origx2 : _), Just (modx1, _)) -> transformation origx2 origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state) + 1
|
||||
-- _ -> state === instruction state
|
||||
-- | Test to see if the length difference between the two stacks post execution is off by one.
|
||||
-- Based on a primitive lens. Should only be used with functions that modify the length of one stack
|
||||
-- by one. The first Int specifies what size the stacks should differ by. The second Int
|
||||
-- specifies how many intial items should be in the stack to not be considered a no-op.
|
||||
diff1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> Int -> Int -> State -> Property
|
||||
diff1Test accessor instruction stackAmt ltAmt state
|
||||
| length (view accessor state) < ltAmt = state === instruction state
|
||||
| otherwise = length (view accessor state) === length (view accessor $ instruction state) + stackAmt
|
||||
|
||||
-- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property
|
||||
-- aa1Test accessor instruction transformation state =
|
||||
@ -27,23 +29,26 @@ module HushGP.PushTests.GenericTests where
|
||||
-- (Just (origx1, _), Just (modx1, _)) -> transformation origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state)
|
||||
-- _ -> state === instruction state
|
||||
|
||||
-- ab1Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> b) -> State -> Property
|
||||
-- ab1Test accessorFrom accessorTo instruction transformation state =
|
||||
-- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
|
||||
-- (Just (t1, _), Just (f1, _)) ->
|
||||
-- t1 === transformation f1 .&&.
|
||||
-- length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&.
|
||||
-- length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1
|
||||
-- _ -> state === instruction state
|
||||
-- | Test to see if the length difference between 2 separate stacks post execution if
|
||||
-- the up/down by a passed amt for the respective stats. Is used to test functions like instructionIntFromFloat.
|
||||
diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> Int -> Int -> State -> Property
|
||||
diff2Test accessorFrom accessorTo instruction ltAmt toAmt fromAmt state
|
||||
| length (view accessorFrom state) < ltAmt = state === instruction state
|
||||
| otherwise = length (view accessorTo $ instruction state) === length (view accessorTo state) + toAmt .&&.
|
||||
length (view accessorFrom $ instruction state) === length (view accessorFrom state) - fromAmt
|
||||
-- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
|
||||
-- (Just (_, _), Just (_, _)) ->
|
||||
-- length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&.
|
||||
-- length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1
|
||||
-- _ -> state === instruction state
|
||||
|
||||
-- aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> (a -> a -> b) -> State -> Property
|
||||
-- aab2Test accessorFrom accessorTo instruction transformation state =
|
||||
-- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
|
||||
-- (Just (t1, _), Just (f1, f2 : _)) ->
|
||||
-- t1 === transformation f1 f2 .&&.
|
||||
-- length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&.
|
||||
-- length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2
|
||||
-- _ -> state === instruction state
|
||||
aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> State -> Property
|
||||
aab2Test accessorFrom accessorTo instruction state =
|
||||
case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
|
||||
(Just (_, _), Just (_, _ : _)) ->
|
||||
length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&.
|
||||
length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2
|
||||
_ -> state === instruction state
|
||||
|
||||
-- popTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property
|
||||
-- popTest accessor instruction state =
|
||||
|
||||
@ -1,8 +1,10 @@
|
||||
module HushGP.PushTests.IntTests where
|
||||
|
||||
import Data.Char
|
||||
import HushGP.State
|
||||
import HushGP.PushTests.GenericTests
|
||||
import HushGP.Instructions.IntInstructions
|
||||
import Control.Lens hiding (uncons)
|
||||
-- import Control.Lens hiding (uncons)
|
||||
import System.Environment
|
||||
import Test.Tasty
|
||||
import Test.Tasty.QuickCheck as QC
|
||||
@ -10,7 +12,7 @@ import Test.Tasty.QuickCheck as QC
|
||||
main :: IO ()
|
||||
main = do
|
||||
setEnv "TASTY_QUICKCHECK_MAX_SIZE" "10"
|
||||
setEnv "TASTY_QUICKCHECK_VERBOSE" "True"
|
||||
setEnv "TASTY_QUICKCHECK_VERBOSE" "False"
|
||||
defaultMain intTests
|
||||
|
||||
-- |Holds the tree for property and unit tests.
|
||||
@ -22,81 +24,146 @@ propIntTests :: TestTree
|
||||
propIntTests = testGroup "Property Int Tests"
|
||||
[
|
||||
QC.testProperty "Property Int Add test" prop_IntAdd
|
||||
, QC.testProperty "Property Int Sub test" prop_IntSub
|
||||
, QC.testProperty "Property Int SubOpp test" prop_IntSubOpp
|
||||
, QC.testProperty "Property Int Multiply test" prop_IntMul
|
||||
, QC.testProperty "Property Int Div test" prop_IntDiv
|
||||
, QC.testProperty "Property Int Div Opp test" prop_IntDivOpp
|
||||
, QC.testProperty "Property Int Mod test" prop_IntMod
|
||||
, QC.testProperty "Property Int Mod Opp test" prop_IntModOpp
|
||||
, QC.testProperty "Property IntFromFloat test" prop_IntFromFloat
|
||||
, QC.testProperty "Property IntFromBool test" prop_IntFromBool
|
||||
, QC.testProperty "Property IntFromChar test" prop_IntFromChar
|
||||
, QC.testProperty "Property IntFromString test" prop_IntFromString
|
||||
, QC.testProperty "Property IntMin test" prop_IntMin
|
||||
, QC.testProperty "Property IntMax test" prop_IntMax
|
||||
, QC.testProperty "Property IntInc test" prop_IntInc
|
||||
, QC.testProperty "Property IntDec test" prop_IntDec
|
||||
, QC.testProperty "Property IntLT test" prop_IntLT
|
||||
, QC.testProperty "Property IntGT test" prop_IntGT
|
||||
, QC.testProperty "Property IntLTE test" prop_IntLTE
|
||||
, QC.testProperty "Property IntGTE test" prop_IntGTE
|
||||
, QC.testProperty "Property IntDup test" prop_IntDup
|
||||
, QC.testProperty "Property IntPop test" prop_IntPop
|
||||
, QC.testProperty "Property IntDupN test" prop_IntDupN
|
||||
, QC.testProperty "Property IntSwap test" prop_IntSwap
|
||||
, QC.testProperty "Property IntRot test" prop_IntRot
|
||||
, QC.testProperty "Property IntFlush test" prop_IntFlush
|
||||
, QC.testProperty "Property IntEQ test" prop_IntEq
|
||||
, QC.testProperty "Property IntStackDepth test" prop_IntStackDepth
|
||||
, QC.testProperty "Property IntYank test" prop_IntYank
|
||||
, QC.testProperty "Property IntYankDup test" prop_IntYankDup
|
||||
, QC.testProperty "Property IntShove test" prop_IntShove
|
||||
, QC.testProperty "Property IntShoveDup test" prop_IntShoveDup
|
||||
, QC.testProperty "Property IntIsStackEmpty test" prop_IntIsStackEmpty
|
||||
, QC.testProperty "Property IntDupItems test" prop_IntDupItems
|
||||
]
|
||||
|
||||
prop_IntAdd :: State -> Property
|
||||
prop_IntAdd state@(State {_int = is}) = if length is < 2 then length (view int (instructionIntAdd state)) === length (view int state) else length (view int (instructionIntAdd state)) === length (view int state) - 1
|
||||
prop_IntAdd = diff1Test int instructionIntAdd 1 2
|
||||
|
||||
-- prop_IntSub :: State -> Property
|
||||
-- prop_IntSub = aaa1Test int instructionIntSub (-)
|
||||
prop_IntSub :: State -> Property
|
||||
prop_IntSub = diff1Test int instructionIntSub 1 2
|
||||
|
||||
-- prop_IntMul :: State -> Property
|
||||
-- prop_IntMul = aaa1Test int instructionIntMul (*)
|
||||
prop_IntSubOpp :: State -> Property
|
||||
prop_IntSubOpp = diff1Test int instructionIntSubOpp 1 2
|
||||
|
||||
-- prop_IntDiv :: State -> Property
|
||||
-- prop_IntDiv state@(State {_int = 0 : _}) = state === instructionIntDiv state
|
||||
-- prop_IntDiv state = aaa1Test int instructionIntDiv div state
|
||||
prop_IntMul :: State -> Property
|
||||
prop_IntMul = diff1Test int instructionIntMul 1 2
|
||||
|
||||
-- prop_IntMod :: State -> Property
|
||||
-- prop_IntMod state@(State {_int = 0 : _}) = state === instructionIntMod state
|
||||
-- prop_IntMod state = aaa1Test int instructionIntMod mod state
|
||||
prop_IntDiv :: State -> Property
|
||||
prop_IntDiv state@(State {_int = 0 : _}) = state === instructionIntDiv state
|
||||
prop_IntDiv state = diff1Test int instructionIntDiv 1 2 state
|
||||
|
||||
-- prop_IntFromFloat :: State -> Property
|
||||
-- prop_IntFromFloat = ab1Test float int instructionIntFromFloat floor
|
||||
prop_IntDivOpp :: State -> Property
|
||||
prop_IntDivOpp state@(State {_int = _ : 0 : _}) = state === instructionIntDivOpp state
|
||||
prop_IntDivOpp state = diff1Test int instructionIntDivOpp 1 2 state
|
||||
|
||||
-- prop_IntFromBool :: State -> Property
|
||||
-- prop_IntFromBool = ab1Test bool int instructionIntFromBool (\x -> if x then 1 else 0)
|
||||
prop_IntMod :: State -> Property
|
||||
prop_IntMod state@(State {_int = 0 : _}) = state === instructionIntMod state
|
||||
prop_IntMod state = diff1Test int instructionIntMod 1 2 state
|
||||
|
||||
-- prop_IntMin :: State -> Property
|
||||
-- prop_IntMin = aaa1Test int instructionIntMin min
|
||||
prop_IntModOpp :: State -> Property
|
||||
prop_IntModOpp state@(State {_int = _ : 0 : _}) = state === instructionIntModOpp state
|
||||
prop_IntModOpp state = diff1Test int instructionIntModOpp 1 2 state
|
||||
|
||||
-- prop_IntMax :: State -> Property
|
||||
-- prop_IntMax = aaa1Test int instructionIntMax max
|
||||
prop_IntFromFloat :: State -> Property
|
||||
prop_IntFromFloat = diff2Test float int instructionIntFromFloat 1 1 1
|
||||
|
||||
-- prop_IntInc :: State -> Property
|
||||
-- prop_IntInc = aa1Test int instructionIntInc (+1)
|
||||
prop_IntFromBool :: State -> Property
|
||||
prop_IntFromBool = diff2Test bool int instructionIntFromBool 1 1 1
|
||||
|
||||
-- prop_IntDec :: State -> Property
|
||||
-- prop_IntDec = aa1Test int instructionIntDec (\x -> x - 1)
|
||||
prop_IntFromChar :: State -> Property
|
||||
prop_IntFromChar = diff2Test char int instructionIntFromChar 1 1 1
|
||||
|
||||
-- prop_IntLT :: State -> Property
|
||||
-- prop_IntLT = aab2Test int bool instructionIntLT (<)
|
||||
prop_IntFromString :: State -> Property
|
||||
prop_IntFromString state@(State {_string = s1 : _}) = if all isDigit s1 then diff2Test string int instructionIntFromString 1 1 1 state else state === instructionIntFromString state
|
||||
prop_IntFromString state = state === instructionIntFromString state
|
||||
|
||||
-- prop_IntGT :: State -> Property
|
||||
-- prop_IntGT = aab2Test int bool instructionIntGT (>)
|
||||
prop_IntMin :: State -> Property
|
||||
prop_IntMin = diff1Test int instructionIntMin 1 2
|
||||
|
||||
-- prop_IntLTE :: State -> Property
|
||||
-- prop_IntLTE = aab2Test int bool instructionIntLTE (<=)
|
||||
prop_IntMax :: State -> Property
|
||||
prop_IntMax = diff1Test int instructionIntMax 1 2
|
||||
|
||||
-- prop_IntGTE :: State -> Property
|
||||
-- prop_IntGTE = aab2Test int bool instructionIntGTE (>=)
|
||||
prop_IntInc :: State -> Property
|
||||
prop_IntInc = diff1Test int instructionIntInc 0 1
|
||||
|
||||
-- prop_IntDup :: State -> Property
|
||||
-- prop_IntDup = dupTest int instructionIntDup
|
||||
prop_IntDec :: State -> Property
|
||||
prop_IntDec = diff1Test int instructionIntDec 0 1
|
||||
|
||||
-- prop_IntPop :: State -> Property
|
||||
-- prop_IntPop = popTest int instructionIntPop
|
||||
prop_IntLT :: State -> Property
|
||||
prop_IntLT = diff2Test int bool instructionIntLT 2 1 2
|
||||
|
||||
-- prop_IntDupN :: State -> Property
|
||||
-- prop_IntDupN = dupTestN int instructionIntDupN
|
||||
prop_IntGT :: State -> Property
|
||||
prop_IntGT = diff2Test int bool instructionIntGT 2 1 2
|
||||
|
||||
-- prop_IntSwap :: State -> Property
|
||||
-- prop_IntSwap = swapTest int instructionIntSwap
|
||||
prop_IntLTE :: State -> Property
|
||||
prop_IntLTE = diff2Test int bool instructionIntLTE 2 1 2
|
||||
|
||||
-- prop_IntRot :: State -> Property
|
||||
-- prop_IntRot = rotTest int instructionIntRot
|
||||
prop_IntGTE :: State -> Property
|
||||
prop_IntGTE = diff2Test int bool instructionIntGTE 2 1 2
|
||||
|
||||
-- prop_IntFlush :: State -> Property
|
||||
-- prop_IntFlush = flushTest int instructionIntFlush
|
||||
prop_IntDup :: State -> Property
|
||||
prop_IntDup = diff1Test int instructionIntDup (-1) 1
|
||||
|
||||
-- prop_IntEq :: State -> Property
|
||||
-- prop_IntEq = aab2Test int bool instructionIntEq (==)
|
||||
prop_IntPop :: State -> Property
|
||||
prop_IntPop = diff1Test int instructionIntPop 1 1
|
||||
|
||||
-- prop_IntStackDepth :: State -> Property
|
||||
-- prop_IntStackDepth = stackDepthTest int instructionIntStackDepth
|
||||
prop_IntDupN :: State -> Property
|
||||
prop_IntDupN state@(State {_int = i1 : _ : _}) = diff1Test int instructionIntDupN ((- fromIntegral (max 0 i1)) + 2) 2 state
|
||||
prop_IntDupN state = state === instructionIntDupN state
|
||||
|
||||
-- prop_IntYank :: State -> Property
|
||||
-- prop_IntYank = yankTest int instructionIntYank
|
||||
prop_IntSwap :: State -> Property
|
||||
prop_IntSwap = diff1Test int instructionIntSwap 0 1
|
||||
|
||||
-- -- prop_IntYankDup :: State -> Property
|
||||
-- -- prop_IntYankDup = yankDupTest int instructionIntYankDup
|
||||
prop_IntRot :: State -> Property
|
||||
prop_IntRot = diff1Test int instructionIntRot 0 3
|
||||
|
||||
prop_IntFlush :: State -> Property
|
||||
prop_IntFlush state@(State {_int = is})= diff1Test int instructionIntFlush (length is) 0 state
|
||||
|
||||
prop_IntEq :: State -> Property
|
||||
prop_IntEq = diff2Test int bool instructionIntEq 2 1 2
|
||||
|
||||
prop_IntStackDepth :: State -> Property
|
||||
prop_IntStackDepth = diff1Test int instructionIntStackDepth (-1) 0
|
||||
|
||||
prop_IntYank :: State -> Property
|
||||
prop_IntYank = diff1Test int instructionIntYank 1 2
|
||||
|
||||
prop_IntYankDup :: State -> Property
|
||||
prop_IntYankDup = diff1Test int instructionIntYankDup 0 2
|
||||
|
||||
prop_IntShove :: State -> Property
|
||||
prop_IntShove = diff1Test int instructionIntShove 1 1
|
||||
|
||||
prop_IntShoveDup :: State -> Property
|
||||
prop_IntShoveDup = diff1Test int instructionIntShoveDup 0 1
|
||||
|
||||
prop_IntIsStackEmpty :: State -> Property
|
||||
prop_IntIsStackEmpty = diff2Test int bool instructionIntIsStackEmpty 0 1 0
|
||||
|
||||
prop_IntDupItems :: State -> Property
|
||||
prop_IntDupItems state@(State {_int = i1 : _ : _})= diff1Test int instructionIntDupItems ((- fromIntegral (max 0 i1)) + 2) 2 state
|
||||
prop_IntDupItems state = state === instructionIntDupItems state
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user