more tests and many more togo

HushGP.cabal

@@ -55,6 +55,7 @@ library
                     , PushTests
                     , PushTests.IntTests
                     , PushTests.GenericTests
+                    , PushTests.UtilTests
 
     -- Modules included in this library but not exported.
     -- other-modules:

src/PushTests.hs

@@ -1,8 +1,10 @@
 module PushTests
   ( module PushTests.GenericTests,
     module PushTests.IntTests,
+    module PushTests.UtilTests,
   )
 where
 
 import PushTests.GenericTests
 import PushTests.IntTests
+import PushTests.UtilTests

src/PushTests/GenericTests.hs

@@ -4,6 +4,7 @@ import State
 import Control.Lens
 import Debug.Trace
 import Test.QuickCheck
+import Instructions.GenericInstructions
 
 -- The naming scheme:
 -- the letters at the beginning represent what kind of transformation (the word I'm using for a basic function) to the states is happening
@@ -84,3 +85,45 @@ rotTest accessor instruction state =
   case (uncons (view accessor state), uncons (view accessor $ instruction state)) of
     (Just (origx1, origx2 : origx3 : _), Just (modx1, modx2 : modx3 : _)) -> (origx1, origx2, origx3) === (modx2, modx3, modx1)
     _ -> state === instruction state
+
+flushTest :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property
+flushTest accessor instruction state =
+  property $ null $ view accessor $ instruction state
+
+stackDepthTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property
+stackDepthTest accessor instruction state =
+  case uncons (view int $ instruction state) of
+    Just (x1, _) -> x1 === length (view accessor state)
+    _ -> state === instruction state
+
+yankTest :: forall a. (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property
+yankTest accessor instruction state@(State {_int = i1 : is}) =
+  let
+    myIndex :: Int
+    myIndex = max 0 (min i1 (length (view accessor state{_int = is}) - 1))
+    item :: a
+    item = view accessor state{_int = is} !! myIndex
+  in
+  case (uncons (view accessor $ instruction state), uncons is) of
+    (Just (x1, _), Just (_, _)) -> x1 === item
+    _ -> state === instruction state
+  -- .&&.  -- unsure how to get this functional
+  -- length (view accessor state{_int = is}) === length (view accessor $ instruction state)
+yankTest _ instruction state = state === instruction state
+
+-- Might just make this a unit test
+-- Come back to this later
+-- yankDupTest :: forall a. (Show a, Eq a) => Lens' State [a] -> (State -> State) -> State -> Property
+-- yankDupTest accessor instruction state@(State {_int = i1 : is}) =
+--   let
+--     myIndex :: Int
+--     myIndex = max 0 (min i1 (length (view accessor state{_int = is}) - 1))
+--     item :: a
+--     item = view accessor state{_int = is} !! myIndex
+--   in
+--   case (uncons (view accessor $ instruction state), uncons is) of
+--     (Just (x1, xs), Just (_, _)) -> x1 === item .&&. (x1 : xs) !!  === item
+--     _ -> state === instruction state
+-- yankDupTest _ instruction state = state === instruction state
+
+-- shoveTest

src/PushTests/IntTests.hs

@@ -3,7 +3,7 @@ module PushTests.IntTests where
 import State
 import Instructions.IntInstructions
 import PushTests.GenericTests
-import Control.Lens hiding (uncons)
+-- import Control.Lens hiding (uncons)
 import Test.QuickCheck
 
 prop_IntAdd :: State -> Property
@@ -67,3 +67,18 @@ prop_IntSwap = swapTest int instructionIntSwap
 
 prop_IntRot :: State -> Property
 prop_IntRot = rotTest int instructionIntRot
+
+prop_IntFlush :: State -> Property
+prop_IntFlush = flushTest int instructionIntFlush
+
+prop_IntEq :: State -> Property
+prop_IntEq = aab2Test int bool instructionIntEq (==)
+
+prop_IntStackDepth :: State -> Property
+prop_IntStackDepth = stackDepthTest int instructionIntStackDepth
+
+prop_IntYank :: State -> Property
+prop_IntYank = yankTest int instructionIntYank
+
+-- prop_IntYankDup :: State -> Property
+-- prop_IntYankDup = yankDupTest int instructionIntYankDup

src/PushTests/UtilTests.hs

@@ -0,0 +1,36 @@
+module PushTests.UtilTests where
+
+import Instructions.GenericInstructions
+import Test.QuickCheck
+
+prop_DeleteAtTest :: Int -> [Int] -> Property
+prop_DeleteAtTest idx lst =
+  idx >= 0 && idx < length lst ==>
+  if null lst
+  then length lst === length (deleteAt idx lst)
+  else length lst === length (deleteAt idx lst) + 1
+
+prop_CombineTupleTest :: Int -> ([Int], [Int]) -> Property
+prop_CombineTupleTest val tup =
+  length (fst tup) + length (snd tup) === length (combineTuple val tup) - 1
+
+prop_CombineTupleListTest :: [Int] -> ([Int], [Int]) -> Property
+prop_CombineTupleListTest lst tup =
+  length (fst tup) + length (snd tup) === length (combineTupleList lst tup) - length lst
+
+-- Could use forAll to only generate valid tests
+prop_InsertAt :: Int -> Int -> [Int] -> Property
+prop_InsertAt idx val lst =
+  idx >= 0 && idx < length lst ==>
+  length lst === length (insertAt idx val lst) - 1 .&&.
+  insertAt idx val lst !! idx === val
+
+prop_ReplaceAt :: Int -> Int -> [Int] -> Property
+prop_ReplaceAt idx val lst =
+  idx >= 0 && idx < length lst ==>
+  length lst === length (replaceAt idx val lst) .&&.
+  replaceAt idx val lst !! idx === val
+
+-- prop_SubList :: Int -> Int -> [Int] -> Property
+-- prop_SubList idx0 idx1 lst =
+  -- idx