reduce noise in tag engine unit test as well as make results apparent

Reviewed-on: ReferenceProjects/riscv-bluespec-classic#18

bs/TagEngine.bs

@@ -1,7 +1,6 @@
 package TagEngine(
-    MkTagType,
+    MkTagType(..),
     TagEngine(..),
-    Util.BasicResult(..),
     mkTagEngine) where
 
 import Vector
@@ -41,18 +40,18 @@ mkTagEngine = do
     requestSignal <- mkRWire  -- Signals a tag request
 
     -- Debug
-    debugOnce <- mkReg True
+    debugOnce <- mkReg False
 
     -- Rules
     addRules |>
         rules
             "debug_initial_state": when debugOnce ==> do
-                $display "tagUsage: " (fshow (readVReg tagUsage))
+                -- $display "tagUsage: " (fshow (readVReg tagUsage))
                 debugOnce := False
 
             "retire_tag": when True ==> do
                 let tag = retireQueue.first
-                $display "Retiring tag: " (fshow tag)
+                -- $display "Retiring tag: " (fshow tag)
                 retireQueue.deq
                 freeTagQueue.enq tag
                 retireSignal.wset tag
@@ -67,13 +66,13 @@ mkTagEngine = do
                             usage' = update usage requestTag True
                             usage'' = update usage' retireTag False
                         writeVReg tagUsage usage''
-                        $display $time " Updated usage (request + retire): " (fshow |> readVReg tagUsage)
+                        -- $display $time " Updated usage (request + retire): " (fshow |> readVReg tagUsage)
                     (Just retireTag, Nothing) -> do
                         (select tagUsage retireTag) := False
-                        $display $time " Updated usage (retire): " (fshow (readVReg tagUsage))
+                        -- $display $time " Updated usage (retire): " (fshow (readVReg tagUsage))
                     (Nothing, Just requestTag) -> do
                         (select tagUsage requestTag) := True
-                        $display $time " Updated usage (request): " (fshow (readVReg tagUsage))
+                        -- $display $time " Updated usage (request): " (fshow (readVReg tagUsage))
                     (Nothing, Nothing) -> action {}
 
     -- Interface

bs/Tests/BusTester.bs

@@ -0,0 +1,67 @@
+package TagEngineTester(mkTagEngineTester) where
+
+import TagEngine
+import ActionSeq
+import Assert
+
+mkTagEngineTester :: Module Empty
+mkTagEngineTester = do
+  tagEngine :: TagEngine 5 <- mkTagEngine
+  runOnce :: Reg Bool <- mkReg False
+
+  s :: ActionSeq
+  s <-
+    let
+      requestTagAction :: Action
+      requestTagAction =
+        do
+          tag <- tagEngine.requestTag
+          $display $time " got tag : " (fshow tag)
+
+      retireTagAction :: UInt 3 -> Action
+      retireTagAction tag =
+        do
+          res <- tagEngine.retireTag tag
+          $display $time " retiring tag : " (fshow tag) " " (fshow res)
+          action {}
+
+    in
+      actionSeq $
+      do requestTagAction
+      |> do
+        requestTagAction
+        -- tag <- tagEngine.requestTag
+      |> do requestTagAction
+      |> do requestTagAction
+      |> do requestTagAction
+      |> do retireTagAction 2
+      -- |> do $display "BEGIN TRY SIMULTANEOUS RETIRE and REQUEST"
+      |> do
+          retireTagAction 4
+          requestTagAction
+      -- |> do $display "END TRY SIMULTANEOUS RETIRE and REQUEST"
+      -- |> do $display "BEGIN TRY SIMULTANEOUS RETIRE and REQUEST"
+      |> do
+          retireTagAction 4
+          requestTagAction
+      -- |> do $display "END TRY SIMULTANEOUS RETIRE and REQUEST"
+      |> do $finish
+      -- |> do retireTagAction 4
+      -- |> do retireTagAction 4
+      -- |> do retireTagAction 0
+      -- |> do requestTagAction
+      -- |> do requestTagAction
+      -- |> do retireTagAction 1
+      -- |> do requestTagAction
+      -- |> do $finish
+
+  addRules $
+    rules
+      -- "counter": when True ==>
+      --   do
+      --     count := count + 1
+      --     $display "count : " (fshow count)
+      "testIncrement": when (runOnce == False) ==>
+        do
+          s.start
+          runOnce := True

bs/Tests/TagEngineTester.bs

@@ -2,6 +2,10 @@ package TagEngineTester(mkTagEngineTester) where
 
 import TagEngine
 import ActionSeq
+import Printf
+import Util
+
+type NumTags = 5
 
 mkTagEngineTester :: Module Empty
 mkTagEngineTester = do
@@ -15,50 +19,58 @@ mkTagEngineTester = do
       requestTagAction =
         do
           tag <- tagEngine.requestTag
-          $display $time " got tag : " (fshow tag)
+          -- $display $time " got tag : " (fshow tag)
+          action {}
 
       retireTagAction :: UInt 3 -> Action
       retireTagAction tag =
         do
           res <- tagEngine.retireTag tag
-          $display $time " retiring tag : " (fshow tag) " " (fshow res)
+          -- $display $time " retiring tag : " (fshow tag) " " (fshow res)
           action {}
 
     in
       actionSeq $
-      do requestTagAction
-      |> do requestTagAction
-      |> do requestTagAction
-      |> do requestTagAction
-      |> do requestTagAction
+      do
+        $display "=== TESTING TagEngine ==="
+        let expectedTag = 4
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
+      |> do
+        let expectedTag = 3
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
+      |> do
+        let expectedTag = 2
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
+      |> do
+        let expectedTag = 1
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
+      |> do
+        let expectedTag = 0
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
       |> do retireTagAction 2
-      -- |> do $display "BEGIN TRY SIMULTANEOUS RETIRE and REQUEST"
       |> do
         retireTagAction 4
-          requestTagAction
-      -- |> do $display "END TRY SIMULTANEOUS RETIRE and REQUEST"
-      -- |> do $display "BEGIN TRY SIMULTANEOUS RETIRE and REQUEST"
+        let expectedTag :: MkTagType NumTags
+            expectedTag = 2
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
       |> do
-          retireTagAction 4
-          requestTagAction
-      -- |> do $display "END TRY SIMULTANEOUS RETIRE and REQUEST"
-      |> do $finish
-      -- |> do retireTagAction 4
-      -- |> do retireTagAction 4
-      -- |> do retireTagAction 0
-      -- |> do requestTagAction
-      -- |> do requestTagAction
-      -- |> do retireTagAction 1
-      -- |> do requestTagAction
-      -- |> do $finish
+        retireTagAction 2
+        let expectedTag = 4
+        tag <- tagEngine.requestTag
+        dynamicAssert (tag == expectedTag) ""
+      |> do
+        $display "=== PASSED ==="
+        terminateSimNoError
 
   addRules $
     rules
-      -- "counter": when True ==>
-      --   do
-      --     count := count + 1
-      --     $display "count : " (fshow count)
-      "testIncrement": when (runOnce == False) ==>
+      "start unit test": when (runOnce == False) ==>
         do
           s.start
           runOnce := True

bs/Top.bs

@@ -7,9 +7,9 @@ import BRAM
 import CBindings
 import Bus
 import TagEngine
+
 import List
 import ActionSeq
-
 import Vector
 import BusTypes
 

bs/Util.bs

@@ -1,24 +1,37 @@
 package Util(
   (|>),
-  BasicResult(..),
-  simulate_for) where
+  terminateSimNoError,
+  terminateSimWithError,
+  dynamicAssert
+  ) where
+
+import CBindings
 
 infixr 0 |>
 
-data BasicResult = Success
-                 | Failure
-                 deriving (Bits, Eq, FShow)
-
 (|>) :: (a -> b) -> a -> b
 f |> x = f x;
 
-simulate_for :: (Bits a n, Arith a, Eq a) => Reg a -> Reg a -> Rules
-simulate_for curr_cycle end_cycle =
-  rules
-    "count_cycle_rule": when True ==> action
-      curr_cycle := curr_cycle + 1
-      if curr_cycle == end_cycle
-        then
-          $finish
-        else
-          $display "cycle = " curr_cycle
+assertMessage :: String -> String -> String
+assertMessage which mess =
+  letseq pos = getStringPosition mess -- get position of original message literal
+  in (which +++" assertion failed: " +++ printPosition pos +++ mess)
+
+dynamicAssert :: Bool -> String -> Action
+dynamicAssert = if not testAssert then (\ _ _ -> noAction)
+                else (\ b s -> if b then noAction else
+                        action
+                          $display (assertMessage "Dynamic" s)
+                          restoreTerminal
+                          $finish 1
+                     )
+
+terminateSimNoError :: Action
+terminateSimNoError = do
+  restoreTerminal
+  $finish 0
+
+terminateSimWithError :: Action
+terminateSimWithError = do
+  restoreTerminal
+  $finish 1