New leadership schedule test

IntersectMBO · Jun 24, 2022 · b5ca5f1 · b5ca5f1
1 parent 18ce831
commit b5ca5f1
Show file tree

Hide file tree

Showing 4 changed files with 493 additions and 3 deletions.
diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -122,9 +122,11 @@ test-suite cardano-testnet-tests
                       , tasty-expected-failure
                       , tasty-hedgehog
                       , text
+                      , time
 
   other-modules:
                         Spec.Cli.KesPeriodInfo
+                        Spec.Cli.LeadershipSchedule
                         Spec.Node.Shutdown
                         Spec.ShutdownOnSlotSynced
                         Testnet.Properties.Cli.KesPeriodInfo

diff --git a/cardano-testnet/src/Test/Process.hs b/cardano-testnet/src/Test/Process.hs
@@ -1,5 +1,6 @@
 module Test.Process
   ( assertByDeadlineIOCustom
+  , assertByDeadlineMCustom
   , bashPath
   , execCli
   , execCli'
@@ -130,3 +131,18 @@ assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do
       else do
         H.annotateShow currentTime
         failMessage GHC.callStack $ "Condition not met by deadline: " <> str
+
+assertByDeadlineMCustom
+  :: (MonadTest m, MonadIO m, HasCallStack)
+  => String -> UTCTime -> m Bool -> m ()
+assertByDeadlineMCustom str deadline f = GHC.withFrozenCallStack $ do
+  success <- f
+  unless success $ do
+    currentTime <- liftIO DTC.getCurrentTime
+    if currentTime < deadline
+      then do
+        liftIO $ IO.threadDelay 1000000
+        assertByDeadlineMCustom str deadline f
+      else do
+        H.annotateShow currentTime
+        failMessage GHC.callStack $ "Condition not met by deadline: " <> str
diff --git a/cardano-testnet/test/Main.hs b/cardano-testnet/test/Main.hs
@@ -5,20 +5,22 @@ module Main
   ) where
 
 import           Prelude
--- import qualified Spec.Cli.KesPeriodInfo
+import           Test.Tasty (TestTree)
+
+import qualified Spec.Cli.LeadershipSchedule
 import qualified Spec.Node.Shutdown
 import qualified Spec.ShutdownOnSlotSynced
 import qualified System.Environment as E
-import           Test.Tasty (TestTree)
 import qualified Test.Tasty as T
 import qualified Test.Tasty.Ingredients as T
 import qualified Test.Util as H
 
 tests :: IO TestTree
 tests = pure $ T.testGroup "test/Spec.hs"
   [ T.testGroup "Spec"
-    [  H.ignoreOnWindows "Shutdown" Spec.Node.Shutdown.hprop_shutdown
+    [ H.ignoreOnWindows "Shutdown" Spec.Node.Shutdown.hprop_shutdown
     , H.ignoreOnWindows "ShutdownOnSlotSynced" Spec.ShutdownOnSlotSynced.hprop_shutdownOnSlotSynced
+    , H.ignoreOnWindows "leadership-schedule" Spec.Cli.LeadershipSchedule.hprop_leadershipSchedule
       -- Ignored on Windows due to <stdout>: commitBuffer: invalid argument (invalid character)
       -- as a result of the kes-period-info output to stdout.
       -- TODO: Babbage temporarily ignored due to broken protocol-state query