Haxl/tests/ProfileTests.hs
Simon Marlow b5821182cf Fix the profile test in haxl-core-unit
Summary:
I didn't look into this too deeply but I'm guessing it was because the
constant expression had been lifted out, so I made it not a constant
expression.

Reviewed By: JonCoens

Differential Revision: D4521430

fbshipit-source-id: 687075d8486b38743b3bd8b9a9f26aa198b2d258
2017-02-08 01:32:25 -08:00

70 lines
2.0 KiB
Haskell

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module ProfileTests where
import Haxl.Prelude
import Data.List
import Haxl.Core
import Haxl.Core.Monad
import Test.HUnit
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Data.IORef
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import TestUtils
mkProfilingEnv = do
env <- makeTestEnv
return env { flags = (flags env) { report = 4 } }
collectsdata :: Assertion
collectsdata = do
e <- mkProfilingEnv
_x <- runHaxl e $
withLabel "bar" $
withLabel "foo" $ do
u <- env userEnv
if length (intersect (HashMap.keys u) ["c"]) > 1
then return 5
else return (4::Int)
profData <- profile <$> readIORef (profRef e)
assertEqual "has data" 3 $ HashMap.size profData
assertBool "foo allocates" $
case profileAllocs <$> HashMap.lookup "foo" profData of
Just x -> x > 0
Nothing -> False
assertEqual "bar does not allocate" (Just 0) $
profileAllocs <$> HashMap.lookup "bar" profData
assertEqual "foo's parent" (Just ["bar"]) $
HashSet.toList . profileDeps <$> HashMap.lookup "foo" profData
exceptions :: Assertion
exceptions = do
env <- mkProfilingEnv
_x <- runHaxl env $
withLabel "outer" $
tryToHaxlException $ withLabel "inner" $
unsafeLiftIO $ evaluate $ force (error "pure exception" :: Int)
profData <- profile <$> readIORef (profRef env)
assertBool "inner label not added" $
not $ HashMap.member "inner" profData
env2 <- mkProfilingEnv
_x <- runHaxl env2 $
withLabel "outer" $
tryToHaxlException $ withLabel "inner" $
throw $ NotFound "haxl exception"
profData <- profile <$> readIORef (profRef env2)
assertBool "inner label added" $
HashMap.member "inner" profData
tests = TestList
[ TestLabel "collectsdata" $ TestCase collectsdata
, TestLabel "exceptions" $ TestCase exceptions
]