mirror of
https://github.com/facebook/Haxl.git
synced 2024-10-03 21:57:26 +03:00
fb2cabbcef
Reviewed By: simonmar Differential Revision: D62383590 fbshipit-source-id: 9d0e60f524be8c40c9934ed4458f5202cbf377a6
82 lines
2.6 KiB
Haskell
82 lines
2.6 KiB
Haskell
{-
|
|
Copyright (c) Meta Platforms, Inc. and affiliates.
|
|
All rights reserved.
|
|
|
|
This source code is licensed under the BSD-style license found in the
|
|
LICENSE file in the root directory of this source tree.
|
|
-}
|
|
|
|
module ParallelTests where
|
|
|
|
import Haxl.Prelude
|
|
import Haxl.Core
|
|
|
|
import Haxl.DataSource.ConcurrentIO
|
|
import SleepDataSource
|
|
|
|
import Data.Time.Clock
|
|
|
|
import Test.HUnit
|
|
|
|
testEnv :: IO (Env () ())
|
|
testEnv = do
|
|
sleepState <- mkConcurrentIOState
|
|
let st = stateSet sleepState stateEmpty
|
|
initEnv st ()
|
|
|
|
sync_test :: IO ()
|
|
sync_test = do
|
|
env <- testEnv
|
|
-- This computation tests that the two arguments of the pOr can fire
|
|
-- without causing an error. The reason we test for this is that the
|
|
-- synchronization involved in this case is a little fragile.
|
|
False <- runHaxl env $ do
|
|
(fmap (const False) (sleep 50)
|
|
`pOr` fmap (const False) (sleep 100))
|
|
`pOr` fmap (const False) (sleep 200)
|
|
return ()
|
|
|
|
semantics_when_computation_is_blocked_test :: IO ()
|
|
semantics_when_computation_is_blocked_test = do
|
|
env <- testEnv
|
|
-- Test semantics of blocking
|
|
let sleepReturn bool t = do
|
|
_ <- sleep t
|
|
return bool
|
|
r <- runHaxl env $ do
|
|
-- All sleep times are different so that they're not cached
|
|
a <- sleepReturn False 10 `pOr` sleepReturn False 11
|
|
b <- sleepReturn False 12 `pOr` sleepReturn True 13
|
|
c <- sleepReturn True 14 `pOr` sleepReturn False 15
|
|
d <- sleepReturn True 16 `pOr` sleepReturn True 17
|
|
return (not a && b && c && d)
|
|
assertBool "pOr blocked semantics" r
|
|
|
|
|
|
timing_test = do
|
|
env <- testEnv
|
|
t0 <- getCurrentTime
|
|
True <- runHaxl env $
|
|
fmap (const True) (sleep 200) `pOr` fmap (const True) (sleep 100)
|
|
t1 <- getCurrentTime
|
|
True <- runHaxl env $
|
|
fmap (const True) (sleep 100) `pOr` fmap (const True) (sleep 200)
|
|
t2 <- getCurrentTime
|
|
False <- runHaxl env $
|
|
fmap (const False) (sleep 200) `pOr` fmap (const False) (sleep 100)
|
|
t3 <- getCurrentTime
|
|
False <- runHaxl env $
|
|
fmap (const False) (sleep 100) `pOr` fmap (const False) (sleep 200)
|
|
t4 <- getCurrentTime
|
|
-- diffUTCTime returns the difference in seconds,
|
|
-- while sleep expects milliseconds
|
|
assert (t4 `diffUTCTime` t3 < 0.2)
|
|
assert (t3 `diffUTCTime` t2 < 0.2)
|
|
assert (t2 `diffUTCTime` t1 < 0.2)
|
|
assert (t1 `diffUTCTime` t0 < 0.2)
|
|
|
|
tests = TestList [TestLabel "sync_test" (TestCase sync_test)
|
|
,TestLabel "timing_test" (TestCase timing_test)
|
|
,TestLabel "semantics_when_computation_is_blocked_test" (TestCase semantics_when_computation_is_blocked_test)
|
|
]
|