mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-23 16:53:02 +03:00
b5a305b5c1
Summary: This collects the highest round in which a label adds a fetch, as well as number of fetches per label per datasource. It reports these, along with aggregated values with scuba sample of profiling data. Aggregation for number of rounds is the maximum round of label or any of label's children. Aggregation for number of fetches is sum. Reviewed By: simonmar Differential Revision: D3316018 fbshipit-source-id: 152690c7b8811d22f566437675c943f755029528
73 lines
2.1 KiB
Haskell
73 lines
2.1 KiB
Haskell
{-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable #-}
|
|
module DataCacheTest (tests) where
|
|
|
|
import Haxl.Core.DataCache as DataCache
|
|
import Haxl.Core
|
|
|
|
import Control.Exception
|
|
import Data.Hashable
|
|
import Data.Traversable
|
|
import Data.Typeable
|
|
import Prelude hiding (mapM)
|
|
import Test.HUnit
|
|
|
|
data TestReq a where
|
|
Req :: Int -> TestReq a -- polymorphic result
|
|
deriving Typeable
|
|
|
|
deriving instance Eq (TestReq a)
|
|
deriving instance Show (TestReq a)
|
|
|
|
instance Hashable (TestReq a) where
|
|
hashWithSalt salt (Req i) = hashWithSalt salt i
|
|
|
|
|
|
dcSoundnessTest :: Test
|
|
dcSoundnessTest = TestLabel "DataCache soundness" $ TestCase $ do
|
|
m1 <- newResult 1
|
|
m2 <- newResult "hello"
|
|
let cache =
|
|
DataCache.insert (Req 1 :: TestReq Int) m1 $
|
|
DataCache.insert (Req 2 :: TestReq String) m2 $
|
|
emptyDataCache
|
|
|
|
-- "Req 1" has a result of type Int, so if we try to look it up
|
|
-- with a result of type String, we should get Nothing, not a crash.
|
|
r <- mapM takeResult $ DataCache.lookup (Req 1) cache
|
|
assertBool "dcSoundness1" $
|
|
case r :: Maybe (Either SomeException String) of
|
|
Nothing -> True
|
|
_something_else -> False
|
|
|
|
r <- mapM takeResult $ DataCache.lookup (Req 1) cache
|
|
assertBool "dcSoundness2" $
|
|
case r :: Maybe (Either SomeException Int) of
|
|
Just (Right 1) -> True
|
|
_something_else -> False
|
|
|
|
r <- mapM takeResult $ DataCache.lookup (Req 2) cache
|
|
assertBool "dcSoundness3" $
|
|
case r :: Maybe (Either SomeException String) of
|
|
Just (Right "hello") -> True
|
|
_something_else -> False
|
|
|
|
r <- mapM takeResult $ DataCache.lookup (Req 2) cache
|
|
assertBool "dcSoundness4" $
|
|
case r :: Maybe (Either SomeException Int) of
|
|
Nothing -> True
|
|
_something_else -> False
|
|
|
|
|
|
dcStrictnessTest :: Test
|
|
dcStrictnessTest = TestLabel "DataCache strictness" $ TestCase $ do
|
|
env <- initEnv stateEmpty ()
|
|
r <- Control.Exception.try $ runHaxl env $
|
|
cachedComputation (Req (error "BOOM")) $ return "OK"
|
|
assertBool "dcStrictnessTest" $
|
|
case r of
|
|
Left (ErrorCall "BOOM") -> True
|
|
_other -> False
|
|
|
|
-- tests :: Assertion
|
|
tests = TestList [dcSoundnessTest, dcStrictnessTest]
|