Fix timeout

src/QuickCheckVEngine/Main.hs

@@ -122,7 +122,7 @@
     , testExcludeRegex = Nothing
     , instrPort        = Nothing
     , saveDir          = Nothing
-    , timeoutDelay     = 6000000000 -- 60 seconds
+    , timeoutDelay     = 20000000 -- 20 seconds
     , testLen          = 2048
     , optShrink        = True
     , optStrict        = False
@@ -282,7 +282,7 @@
   (flags, _) <- commandOpts rawArgs
   let verbosity = optVerbosity flags
   when (verbosity > 1) $ print flags
   let checkRegex incReg excReg str = (str =~ (fromMaybe ".*" incReg)) && (not $ str =~ fromMaybe "a^" excReg)
   let archDesc = arch flags
   let csrFilter idx = checkRegex (csrIncludeRegex flags) (csrExcludeRegex flags) (fromMaybe "reserved" $ csrs_nameFromIndex idx)
   let testParams = T.TestParams { T.archDesc  = archDesc
@@ -300,7 +300,7 @@
         quickCheckWithResult (Args Nothing 1 1 len (verbosity > 0) (if doShrink then 1000 else 0))
                              (prop implA m_implB alive onFail archDesc (timeoutDelay flags) verbosity Nothing (optIgnoreAsserts flags) (optStrict flags) (return test))
   let check_mcause_on_trap :: Test TestResult -> Test TestResult
       check_mcause_on_trap (trace :: Test TestResult) = if or (hasTrap <$> trace) then filterTest p trace <> wrapTest testSuffix else trace
         where hasTrap (_, a, b) = maybe False rvfiIsTrap a || maybe False rvfiIsTrap b
               testSuffix = noShrink $ singleSeq [ csrrs 1 (unsafe_csrs_indexFromName "mcause") 0
                                                 , csrrs 1 (unsafe_csrs_indexFromName "mtval" ) 0
@@ -340,7 +340,7 @@
   let checkResult = if verbosity > 1 then verboseCheckWithResult else quickCheckWithResult
   let checkGen gen remainingTests =
         checkResult (Args Nothing remainingTests 1 (testLen flags) (verbosity > 0) (if optShrink flags then 1000 else 0))
                     (prop implA m_implB alive (checkTrapAndSave Nothing) archDesc (timeoutDelay flags) verbosity (if (optSaveAll flags) then (saveDir flags) else Nothing) (optIgnoreAsserts flags) (optStrict flags) gen)
   failuresRef <- newIORef 0
   let checkFile (memoryInitFile :: Maybe FilePath) (skipped :: Int) (fileName :: FilePath)
         | skipped == 0 = do putStrLn $ "Reading trace from " ++ fileName
@@ -380,7 +380,7 @@
               where attemptTest (label, description, archReqs, template) =
                       if archReqs archDesc then do
                         putStrLn $ label ++ " -- " ++ description ++ ":"
                         (if optContinueOnFail flags then repeatTillTarget else (\f t -> f t >> return ())) ((numTests <$>) . (doCheck (wrapTest <$> (T.genTest testParams template)))) (nTests flags)
                       else
                         putStrLn $ "Warning: skipping " ++ label ++ " since architecture requirements not met"
                     repeatTillTarget f t = if t <= 0 then return () else f t >>= (\x -> repeatTillTarget f (t - x))

src/QuickCheckVEngine/MainHelpers.hs

@@ -212,8 +212,7 @@ prop connA m_connB alive onFail arch delay verbosity saveDir ignoreAsserts stric
         -- We don't want to shrink once one of the implementations has died,
         -- so always return that the property is true
         onSubsequentDeaths _ = do
-          putStrLn "Warning: reporting success since implementations not running"
-          return $ property True
+          return $ property Discard
 
 -- | Send a sequence of instructions ('[DII_Packet]') to the implementations
 --   running behind the two provided 'Sockets's and recieve their respective
@@ -251,8 +250,8 @@ doRVFIDII connA m_connB alive delay verbosity saveDir test = do
       m_traceAB <- maybe (return . Just $ emptyTrace traceA) (receive "implementation B" traceA) m_connB
       --
       when (isNothing m_traceA || isNothing m_traceAB) $ writeIORef alive False
-      when (isNothing m_traceA) $ putStrLn "Error: implementation A timeout. Forcing all future tests to report 'SUCCESS'"
-      when (isNothing m_traceAB) $ putStrLn "Error: implementation B timeout. Forcing all future tests to report 'SUCCESS'"
+      when (isNothing m_traceA) $ putStrLn "Error: implementation A timeout. Discarding all future tests."
+      when (isNothing m_traceAB) $ putStrLn "Error: implementation B timeout. Discarding all future tests."
       --
       case saveDir of
         Nothing -> do return ()
@@ -267,7 +266,7 @@ doRVFIDII connA m_connB alive delay verbosity saveDir test = do
       Right t -> return $ Just $ (\((x,y),z) -> (x,y,z)) <$> t
       Left (SomeException e) -> do
         writeIORef alive False
-        putStrLn ("Error: exception on IO with implementations. Forcing all future tests to report 'SUCCESS': " ++ show e)
+        putStrLn ("Error: exception on IO with implementations. Discarding all future tests: " ++ show e)
         return Nothing
   else do
      putStrLn "Warning: doRVFIDII called when both implementations are not alive"