Merge pull request #10 from lisphacker/unit-tests

T21 Unit tests

src/TIS100/Tiles/T21.hs

@@ -139,7 +139,7 @@ addValueToPC :: (T21, Maybe Value) -> T21
 addValueToPC (t, Just (Value v)) = t{tileState = (tileState t){pc = nextPC}}
  where
   (Address pc') = pc $ tileState t
-  nextPC = Address $ (pc' + v) `mod` V.length (tileProgram t)
+  nextPC = Address $ max 0 $ min (pc' + v) (V.length (tileProgram t) - 1)
 addValueToPC (t, Nothing) = t
 
 instance IsConnectedTile T21 where
@@ -174,17 +174,22 @@ instance IsConnectedTile T21 where
         SUBI v -> incPC $ writeRegOrPort (Register ACC) $ maybeAddSub (flip (-)) (t, Just v) $ readRegOrPort (Register ACC) t
         SUB src -> incPC $ writeRegOrPort (Register ACC) $ maybeAddSub (flip (-)) (readRegOrPort src t) (readRegOrPort (Register ACC) t)
         NEG -> incPC $ writeRegOrPort (Register ACC) $ maybeAddSub (-) (t, Just $ Value 0) $ readRegOrPort (Register ACC) t
-        JMP addr -> t{tileState = (tileState t){pc = addr}}
+        JMP addr -> t{tileState = (tileState t){pc = clampAddr addr}}
         JCC cond addr -> case cond of
-          EZ -> if acc (tileState t) == 0 then t{tileState = (tileState t){pc = addr}} else incPC t
-          NZ -> if acc (tileState t) /= 0 then t{tileState = (tileState t){pc = addr}} else incPC t
-          GZ -> if acc (tileState t) > 0 then t{tileState = (tileState t){pc = addr}} else incPC t
-          LZ -> if acc (tileState t) < 0 then t{tileState = (tileState t){pc = addr}} else incPC t
+          EZ -> if acc (tileState t) == 0 then t{tileState = (tileState t){pc = clampAddr addr}} else incPC t
+          NZ -> if acc (tileState t) /= 0 then t{tileState = (tileState t){pc = clampAddr addr}} else incPC t
+          GZ -> if acc (tileState t) > 0 then t{tileState = (tileState t){pc = clampAddr addr}} else incPC t
+          LZ -> if acc (tileState t) < 0 then t{tileState = (tileState t){pc = clampAddr addr}} else incPC t
         JROI v -> addValueToPC (t, Just v)
         JRO src -> addValueToPC $ readRegOrPort src t
+
       maybeAddSub :: (Value -> Value -> Value) -> (T21, Maybe Value) -> (T21, Maybe Value) -> (T21, Maybe Value)
       maybeAddSub f (t', Just v1) (_, Just v2) = (t', Just $ f v1 v2)
       maybeAddSub _ tv _ = tv -- Just to silence the linter
+      clampAddr :: Address -> Address
+      clampAddr (Address a) = Address $ max 0 $ min a maxAddr
+       where
+        maxAddr = V.length (tileProgram t) - 1
 
 readRegOrPort :: RegisterOrPort -> T21 -> (T21, Maybe Value)
 readRegOrPort rp t = case rp of

test/Main.hs

@@ -4,12 +4,15 @@ import Test.Hspec
 import Test.Tasty qualified
 import Test.Tasty.Hspec
 
-import Sim.Tests qualified as SimTests
+import Sim.Examples qualified as SimExamplesTests
+import Sim.T21 qualified as SimT21Tests
 
 main :: IO ()
 main = do
   test <- testSpec "tis100" spec
   Test.Tasty.defaultMain test
 
 spec :: Spec
-spec = SimTests.simTestsSpec
+spec = parallel $ do
+  SimT21Tests.simTestsSpec
+  SimExamplesTests.simTestsSpec

test/Sim/Tests.hs → test/Sim/Examples.hs

@@ -1,4 +1,4 @@
-module Sim.Tests where
+module Sim.Examples where
 
 import GHC.IO (unsafePerformIO)
 import TIS100.Parser.Config qualified as ParserCfg
@@ -30,6 +30,6 @@ testExampleAsm n asmFilePath cfgFilePath = do
     return (ParserCfg.refOutputs cfg, Run.outputs finalSimState)
 
 simTestsSpec :: Spec
-simTestsSpec = parallel $ do
+simTestsSpec = describe "Example Tests" $ parallel $ do
   testExampleAsm "segment00150" "examples/segment00150/segment00150.asm" "examples/segment00150/segment00150.cfg"
   testExampleAsm "segment20176" "examples/segment20176/segment20176.asm" "examples/segment20176/segment20176.cfg"

test/Sim/T21.hs

@@ -0,0 +1,267 @@
+module Sim.T21 where
+
+import Control.Monad (forM_)
+import Data.Vector qualified as V
+import TIS100.Tiles.Base
+import TIS100.Tiles.ConnectedTile (step)
+import TIS100.Tiles.T21
+import Test.Hspec
+import Prelude hiding (init, last)
+
+mkT21TileWithPC :: Address -> Value -> Value -> [Instruction] -> T21
+mkT21TileWithPC initPc initAcc initBak instns =
+  T21
+    { tileProgram =
+        V.fromList instns
+    , tileState =
+        TileState
+          { acc = initAcc
+          , bak = initBak
+          , last = ANY
+          , pc = initPc
+          , runState = Ready
+          }
+    }
+
+mkT21Tile :: Value -> Value -> [Instruction] -> T21
+mkT21Tile = mkT21TileWithPC 0
+
+ports :: [Port']
+ports = [UP, DOWN, LEFT, RIGHT]
+
+testADDSUB :: Bool -> Spec
+testADDSUB add = describe ("Testing " ++ insName) $ do
+  testADDSUB_ACC
+  testADDSUB_BAK
+  forM_ ports testADDSUB_Port
+ where
+  testADDSUB_ACC = do
+    let init = mkT21Tile 10 20 [if add then ADD (Register ACC) else SUB (Register ACC)]
+    let next = step init
+
+    describe ("Testing " ++ insName ++ " ACC") $ do
+      it "Status" $ do
+        acc (tileState next) `shouldBe` Value (f 10 10)
+
+  testADDSUB_BAK = do
+    let init = mkT21Tile 10 20 [if add then ADD (Register BAK) else SUB (Register BAK)]
+    let next = step init
+
+    describe ("Testing " ++ insName ++ " ACC") $ do
+      it "Status" $ do
+        acc (tileState next) `shouldBe` Value (f 10 20)
+
+  testADDSUB_Port port = do
+    let init = mkT21Tile 10 20 [if add then ADD (Port port) else SUB (Port port)]
+    let next = step init
+
+    describe ("Testing " ++ insName ++ " " ++ show port) $ do
+      it "Status" $ do
+        acc (tileState next) `shouldBe` Value 10
+        runState (tileState next) `shouldBe` WaitingOnRead port Nothing
+
+  f = if add then (+) else (-)
+  insName = if add then "ADD" else "SUB"
+
+testADD :: Spec
+testADD = testADDSUB True
+testSUB :: Spec
+testSUB = testADDSUB False
+
+testADDSUBI :: Bool -> Spec
+testADDSUBI add = do
+  let init = mkT21Tile 10 0 [if add then ADDI (Value 20) else SUBI (Value 20)]
+  let next = step init
+
+  describe ("Testing " ++ insName) $ do
+    it "Status" $ do
+      acc (tileState next) `shouldBe` (f (Value 10) (Value 20))
+ where
+  f = if add then (+) else (-)
+  insName = if add then "ADDI" else "SUBI"
+
+testADDI :: Spec
+testADDI = testADDSUBI True
+testSUBI :: Spec
+testSUBI = testADDSUBI False
+
+testConditionalJump :: String -> Value -> Value -> JumpCondition -> Spec
+testConditionalJump insName trueAcc falseAcc jc = describe ("Testing " ++ insName) $ do
+  testFalse (JCC jc (Address 5)) (Address 4)
+  testTrue "without overflow/underflow" (JCC jc (Address 5)) (Address 5)
+  testTrue "underflow" (JCC jc (Address (-5))) (Address 0)
+  testTrue "overflow" (JCC jc (Address 10)) (Address 6)
+ where
+  testFalse ins tgtAddr = do
+    let next = step $ init falseAcc ins
+
+    describe "Testing false" $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` tgtAddr
+
+  testTrue desc ins tgtAddr = do
+    let next = step $ init trueAcc ins
+
+    describe ("Testing " ++ desc) $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` tgtAddr
+
+  init initAcc ins = mkT21TileWithPC 3 initAcc 0 [NOP, NOP, NOP, ins, NOP, NOP, NOP]
+
+testUnconditionalJump :: Spec
+testUnconditionalJump = describe "Testing JMP" $ do
+  testUnconditionalJump' "without overflow/underflow" (JMP (Address 5)) (Address 5)
+  testUnconditionalJump' "underflow" (JMP (Address (-5))) (Address 0)
+  testUnconditionalJump' "overflow" (JMP (Address 10)) (Address 6)
+ where
+  testUnconditionalJump' desc ins tgtAddr = do
+    let next = step $ init ins
+
+    describe ("Testing " ++ desc) $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` tgtAddr
+
+  init ins = mkT21TileWithPC 3 2 0 [NOP, NOP, NOP, ins, NOP, NOP, NOP]
+
+testJEZ :: Spec
+testJEZ = testConditionalJump "JEZ" (Value 0) (Value 10) EZ
+testJGZ :: Spec
+testJGZ = testConditionalJump "JGZ" (Value 10) (Value 0) GZ
+testJLZ :: Spec
+testJLZ = testConditionalJump "JLZ" (Value (-10)) (Value 0) LZ
+testJNZ :: Spec
+testJNZ = testConditionalJump "JNZ" (Value 10) (Value 0) NZ
+testJMP :: Spec
+testJMP = testUnconditionalJump
+testJRO :: Spec
+testJRO = describe "JRO" $ do
+  testJRO_ACC "without overflow/underflow" 2 (Address 5)
+  testJRO_ACC "underflow" (-5) (Address 0)
+  testJRO_ACC "overflow" 5 (Address 6)
+  forM_ ports testJRO_Port
+ where
+  testJRO_ACC desc initAcc tgtAddr = do
+    let next = step $ init initAcc (JRO (Register ACC))
+
+    describe ("Testing " ++ desc) $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` tgtAddr
+
+  testJRO_Port port = do
+    let next = step $ init 2 (JRO (Port port))
+
+    describe ("Testing JRO " ++ show port) $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` Address 3
+        runState (tileState next) `shouldBe` WaitingOnRead port Nothing
+
+  init initAcc ins = mkT21TileWithPC 3 initAcc 0 [NOP, NOP, NOP, ins, NOP, NOP, NOP]
+
+testJROI :: Spec
+testJROI = describe "JROI" $ do
+  testJROI' "without overflow/underflow" (JROI (Value 2)) (Address 5)
+  testJROI' "underflow" (JROI (Value (-5))) (Address 0)
+  testJROI' "overflow" (JROI (Value 5)) (Address 6)
+ where
+  testJROI' desc ins tgtAddr = do
+    let next = step $ init ins
+
+    describe ("Testing " ++ desc) $ do
+      it "Status" $ do
+        pc (tileState next) `shouldBe` tgtAddr
+
+  init ins = mkT21TileWithPC 3 2 0 [NOP, NOP, NOP, ins, NOP, NOP, NOP]
+
+testMOVI :: Spec
+testMOVI = describe "Testing MOVI" $ do
+  testMOVI_ACC
+  forM_ ports testMOVI_Port
+ where
+  testMOVI_ACC = do
+    let init = mkT21Tile 10 20 [MOVI (Value 40) (Register ACC)]
+    let next = step init
+
+    describe "Testing MOVI <val>, ACC" $ do
+      it "Status" $ do
+        acc (tileState next) `shouldBe` Value 40
+
+  testMOVI_Port port = do
+    let init = mkT21Tile 10 20 [MOVI (Value 40) (Port port)]
+    let next = step init
+
+    describe ("Testing MOVI <val>, " ++ show port) $ do
+      it "Status" $ do
+        runState (tileState next) `shouldBe` WaitingOnWrite port (Value 40)
+
+testMOV :: Spec
+testMOV = describe "Testing MOV" $ do
+  forM_ ports testMOV_ACC_Port
+  forM_ ports testMOV_Port_ACC
+ where
+  testMOV_ACC_Port port = do
+    let init = mkT21Tile 10 20 [MOV (Register ACC) (Port port)]
+    let next = step init
+
+    describe ("Testing MOV ACC, " ++ show port) $ do
+      it "Status" $ do
+        runState (tileState next) `shouldBe` WaitingOnWrite port (acc $ tileState init)
+
+  testMOV_Port_ACC port = do
+    let init = mkT21Tile 10 20 [MOV (Port port) (Register ACC)]
+    let next = step init
+
+    describe ("Testing MOV " ++ show port ++ ", ACC") $ do
+      it "Status" $ do
+        runState (tileState next) `shouldBe` WaitingOnRead port Nothing
+
+testNEG :: Spec
+testNEG = describe "Testing NEG" $ do
+  let init = mkT21Tile 10 20 [NEG]
+  let next = step init
+
+  describe "Testing NEG" $ do
+    it "Status" $ do
+      acc (tileState next) `shouldBe` Value (-10)
+
+testNOP :: Spec
+testNOP = describe "Testing NOPs" $ do
+  testNOP' NOP
+  testNOP' (ADD (Register NIL))
+  testNOP' (SUB (Register NIL))
+ where
+  testNOP' ins = do
+    let init = mkT21Tile 10 20 [ins]
+    let next = step init
+
+    describe ("Testing " ++ show ins) $ do
+      it "Status" $ do
+        next `shouldBe` init
+
+testSWP :: Spec
+testSWP = describe "Testing SWP" $ do
+  let init = mkT21Tile 10 20 [SWP]
+  let next = step init
+
+  describe "Testing SWP" $ do
+    it "Status" $ do
+      acc (tileState next) `shouldBe` Value 20
+      bak (tileState next) `shouldBe` Value 10
+
+simTestsSpec :: Spec
+simTestsSpec = describe "Intra-T21 tests" $ parallel $ do
+  testADD
+  testADDI
+  testJEZ
+  testJGZ
+  testJLZ
+  testJNZ
+  testJMP
+  testJRO
+  testJROI
+  testMOV
+  testMOVI
+  testNEG
+  testNOP
+  testSUB
+  testSUBI
+  testSWP