Commit 3d3e0122 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Try to make testExceptions more predictable

parent 01994dee
Pipeline #4398 passed with stages
in 10 minutes and 48 seconds
...@@ -2019,6 +2019,7 @@ constraints: any.AC-Angle ==1.0, ...@@ -2019,6 +2019,7 @@ constraints: any.AC-Angle ==1.0,
any.record-hasfield ==1.0, any.record-hasfield ==1.0,
any.record-wrangler ==0.1.1.0, any.record-wrangler ==0.1.1.0,
any.records-sop ==0.1.1.0, any.records-sop ==0.1.1.0,
any.recover-rtti ==0.4.3,
any.recursion-schemes ==5.2.2.2, any.recursion-schemes ==5.2.2.2,
any.reducers ==3.12.4, any.reducers ==3.12.4,
any.ref-fd ==0.5, any.ref-fd ==0.5,
......
...@@ -922,6 +922,7 @@ test-suite garg-test ...@@ -922,6 +922,7 @@ test-suite garg-test
, patches-map , patches-map
, quickcheck-instances , quickcheck-instances
, raw-strings-qq , raw-strings-qq
, recover-rtti
, servant-job , servant-job
, stm , stm
, tasty , tasty
......
...@@ -124,6 +124,7 @@ extra-deps: ...@@ -124,6 +124,7 @@ extra-deps:
- monoid-extras-0.5.1@sha256:438dbfd7b4dce47d8f0ca577f56caf94bd1e21391afa545cad09fe7cf2e5793d,2333 - monoid-extras-0.5.1@sha256:438dbfd7b4dce47d8f0ca577f56caf94bd1e21391afa545cad09fe7cf2e5793d,2333
- rake-0.0.1@sha256:3380f6567fb17505d1095b7f32222c0b631fa04126ad39726c84262da99c08b3,2025 - rake-0.0.1@sha256:3380f6567fb17505d1095b7f32222c0b631fa04126ad39726c84262da99c08b3,2025
- random-1.2.1 - random-1.2.1
- recover-rtti-0.4.3
- servant-cassava-0.10.1@sha256:07e7b6ca67cf57dcb4a0041a399a25d058844505837c6479e01d62be59d01fdf,1665 - servant-cassava-0.10.1@sha256:07e7b6ca67cf57dcb4a0041a399a25d058844505837c6479e01d62be59d01fdf,1665
- servant-ekg-0.3.1@sha256:19bd9dc3943983da8e79d6f607614c68faea4054fb889d508c8a2b67b6bdd448,2203 - servant-ekg-0.3.1@sha256:19bd9dc3943983da8e79d6f607614c68faea4054fb889d508c8a2b67b6bdd448,2203
- servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234 - servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
......
...@@ -17,6 +17,7 @@ import Data.Either ...@@ -17,6 +17,7 @@ import Data.Either
import Data.List import Data.List
import Data.Sequence (Seq, (|>), fromList) import Data.Sequence (Seq, (|>), fromList)
import Data.Time import Data.Time
import Debug.RecoverRTTI (anythingToString)
import Prelude import Prelude
import System.IO.Unsafe import System.IO.Unsafe
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
...@@ -55,9 +56,8 @@ addJobToSchedule jobt mvar = do ...@@ -55,9 +56,8 @@ addJobToSchedule jobt mvar = do
data Counts = Counts { countAs :: Int, countBs :: Int } data Counts = Counts { countAs :: Int, countBs :: Int }
deriving (Eq, Show) deriving (Eq, Show)
jobDuration, initialDelay :: Int jobDuration :: Int
jobDuration = 100000 jobDuration = 100000
initialDelay = 20000
type Timer = TVar Bool type Timer = TVar Bool
...@@ -131,10 +131,10 @@ testMaxRunners = do ...@@ -131,10 +131,10 @@ testMaxRunners = do
allSamples <- atomically $ flushTQueue samples allSamples <- atomically $ flushTQueue samples
length allSamples `shouldSatisfy` (> 0) length allSamples `shouldSatisfy` (> 0)
forM_ allSamples $ \runLog -> forM_ allSamples $ \runLog -> do
annotate "predicate to satisfy: (x == [\"Job #1\", \"Job #2\"] || x == [\"Job #3\", \"Job #4\"]" $ annotate "predicate to satisfy: (x `isInfixOf` [\"Job #1\", \"Job #2\"] || x `isInfixOf` [\"Job #3\", \"Job #4\"]" $
shouldSatisfy (sort runLog) shouldSatisfy (sort runLog)
(\x -> x == ["Job #1", "Job #2"] || x == ["Job #3", "Job #4"]) (\x -> x `isInfixOf` ["Job #1", "Job #2"] || x `isInfixOf` ["Job #3", "Job #4"])
testPrios :: IO () testPrios :: IO ()
testPrios = do testPrios = do
...@@ -167,18 +167,19 @@ testPrios = do ...@@ -167,18 +167,19 @@ testPrios = do
testExceptions :: IO () testExceptions :: IO ()
testExceptions = do testExceptions = do
k <- genSecret k <- genSecret
let settings = defaultJobSettings 2 k let settings = defaultJobSettings 1 k
st :: JobsState JobT [String] () <- newJobsState settings defaultPrios st :: JobsState JobT [String] () <- newJobsState settings defaultPrios
jid <- pushJob A () jid <- pushJob A ()
(\_jHandle _inp _log -> readFile "/doesntexist.txt" >>= putStrLn) (\_jHandle _inp _log -> readFile "/doesntexist.txt" >>= putStrLn)
settings st settings st
threadDelay initialDelay -- Wait 1 second to make sure the job is finished.
threadDelay $ 1_000_000
mjob <- lookupJob jid (jobsData st) mjob <- lookupJob jid (jobsData st)
case mjob of case mjob of
Nothing -> error "boo" Nothing -> fail "lookupJob failed, job not found!"
Just je -> case jTask je of Just je -> case jTask je of
DoneJ _ r -> isLeft r `shouldBe` True DoneJ _ r -> isLeft r `shouldBe` True
_ -> error "boo2" unexpected -> fail $ "Expected job to be done, but got: " <> anythingToString unexpected
return () return ()
testFairness :: IO () testFairness :: IO ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment