mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-23 08:43:16 +03:00
Add correctness tests for outgone-fetches logging (#99)
Summary: Pull Request resolved: https://github.com/facebook/Haxl/pull/99 This adds unit tests to haxl, to make sure we are tracking the outgone fetches correctly.. Reviewed By: simonmar Differential Revision: D14683672 fbshipit-source-id: 49a318f0b8aa38c2af154fcbe0946122e70b9565
This commit is contained in:
parent
c365886e79
commit
5f2ebd2580
@ -132,6 +132,7 @@ test-suite test
|
||||
if impl(ghc >= 8.0)
|
||||
other-modules:
|
||||
AdoTests
|
||||
OutgoneFetchesTests
|
||||
|
||||
other-modules:
|
||||
AllTests
|
||||
|
@ -13,6 +13,7 @@ import CoreTests
|
||||
import DataCacheTest
|
||||
#if __GLASGOW_HASKELL__ >= 801
|
||||
import AdoTests
|
||||
import OutgoneFetchesTests
|
||||
#endif
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
import ProfileTests
|
||||
@ -33,6 +34,7 @@ allTests = TestList
|
||||
, TestLabel "DataCacheTests" DataCacheTest.tests
|
||||
#if __GLASGOW_HASKELL__ >= 801
|
||||
, TestLabel "AdoTests" $ AdoTests.tests False
|
||||
, TestLabel "OutgoneFetchesTest" OutgoneFetchesTests.tests
|
||||
#endif
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
, TestLabel "ProfileTests" ProfileTests.tests
|
||||
|
137
tests/OutgoneFetchesTests.hs
Normal file
137
tests/OutgoneFetchesTests.hs
Normal file
@ -0,0 +1,137 @@
|
||||
-- Copyright (c) 2014-present, Facebook, Inc.
|
||||
-- All rights reserved.
|
||||
--
|
||||
-- This source code is distributed under the terms of a BSD license,
|
||||
-- found in the LICENSE file.
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
module OutgoneFetchesTests (tests) where
|
||||
|
||||
import Haxl.Prelude as Haxl
|
||||
import Prelude()
|
||||
|
||||
import Haxl.Core
|
||||
import Haxl.DataSource.ConcurrentIO
|
||||
import Haxl.Core.RequestStore (getMapFromRCMap)
|
||||
|
||||
import Data.IORef
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Data.Typeable
|
||||
import Test.HUnit
|
||||
import System.Timeout
|
||||
|
||||
import ExampleDataSource
|
||||
import SleepDataSource
|
||||
|
||||
testEnv = do
|
||||
exstate <- ExampleDataSource.initGlobalState
|
||||
sleepState <- mkConcurrentIOState
|
||||
let st = stateSet exstate $ stateSet sleepState stateEmpty
|
||||
e <- initEnv st ()
|
||||
return e { flags = (flags e) {report = 1} }
|
||||
-- report=1 to enable fetches tracking
|
||||
|
||||
-- A cheap haxl computation we interleave b/w the @sleep@ fetches.
|
||||
wombats :: GenHaxl () () Int
|
||||
wombats = length <$> listWombats 3
|
||||
|
||||
getFetches :: Env () () -> IO (Map Text (Map TypeRep Int))
|
||||
getFetches env = getMapFromRCMap <$> readIORef (submittedReqsRef env)
|
||||
|
||||
outgoneFetchesTest :: Test
|
||||
outgoneFetchesTest = TestCase $ do
|
||||
let
|
||||
withTimeout env h = timeout 2000 $ runHaxl env h -- 2 ms
|
||||
|
||||
-- test that a completed datasource fetch doesn't show up in Env
|
||||
env <- testEnv
|
||||
|
||||
withTimeout env $ do
|
||||
_ <- sleep 1 -- 1 ms
|
||||
_ <- sleep 1 -- should be cached
|
||||
_ <- sleep 1
|
||||
wombats
|
||||
|
||||
fetchesMap <- getFetches env
|
||||
assertEqual "outgoneFetches1" 0 (Map.size fetchesMap)
|
||||
|
||||
-- test that unfinished datasource fetches shows up in Env
|
||||
env <- testEnv
|
||||
|
||||
withTimeout env $ do
|
||||
_ <- sleep 4 -- 4 ms
|
||||
_ <- wombats
|
||||
_ <- sleep 5 -- 4 ms
|
||||
_ <- wombats
|
||||
return ()
|
||||
|
||||
fetchesMap <- getFetches env
|
||||
assertEqual "outgoneFetches2" 1 (Map.size fetchesMap)
|
||||
assertEqual "outgoneFetches2"
|
||||
(Map.fromList
|
||||
[ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep))
|
||||
, Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 2)]
|
||||
)
|
||||
])
|
||||
fetchesMap
|
||||
|
||||
-- test for finished/unfinished fetches from the same datasource
|
||||
env <- testEnv
|
||||
|
||||
withTimeout env $ do
|
||||
_ <- sleep 1 -- 1 ms
|
||||
_ <- sleep 4
|
||||
_ <- sleep 5
|
||||
return ()
|
||||
|
||||
fetchesMap <- getFetches env
|
||||
assertEqual "outgoneFetches3"
|
||||
(Map.fromList
|
||||
[ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep))
|
||||
, Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 2)]
|
||||
)
|
||||
])
|
||||
fetchesMap
|
||||
|
||||
-- test for cached requests not showing up twice in ReqCountMap
|
||||
env <- testEnv
|
||||
|
||||
withTimeout env $ do
|
||||
_ <- sleep 4 -- 3 ms
|
||||
_ <- sleep 4
|
||||
return ()
|
||||
|
||||
fetchesMap <- getFetches env
|
||||
assertEqual "outgoneFetches4"
|
||||
(Map.fromList
|
||||
[ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep))
|
||||
, Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 1)]
|
||||
)
|
||||
])
|
||||
fetchesMap
|
||||
|
||||
-- test for unsent requests not showing up in ReqCountMap
|
||||
env <- testEnv
|
||||
|
||||
withTimeout env $ do
|
||||
_ <- sleep =<< sleep 4 -- second req should never be sent
|
||||
return ()
|
||||
|
||||
fetchesMap <- getFetches env
|
||||
assertEqual "outgoneFetches5"
|
||||
(Map.fromList
|
||||
[ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep))
|
||||
, Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 1)]
|
||||
)
|
||||
])
|
||||
fetchesMap
|
||||
|
||||
|
||||
|
||||
|
||||
tests = TestList
|
||||
[ TestLabel "outgoneFetchesTest" outgoneFetchesTest
|
||||
]
|
@ -14,7 +14,7 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
module SleepDataSource (
|
||||
sleep,
|
||||
Sleep, sleep,
|
||||
) where
|
||||
|
||||
import Haxl.Prelude
|
||||
|
Loading…
Reference in New Issue
Block a user