mirror of
https://github.com/facebook/Haxl.git
synced 2024-10-04 06:07:32 +03:00
e5f95d6213
Summary: Bump the minimum Haxl version to GHC 8.2, which at this point is 2.5 years old but more importantly has many features that are really helpful in Haxl (such as the hs_try_put_mvar API function, which is really useful for BackgroundFetch) Reviewed By: josefs Differential Revision: D19327952 fbshipit-source-id: f635068fe9fb8f1d1f0d83ccbf9c3c04947183a0
130 lines
3.6 KiB
Haskell
130 lines
3.6 KiB
Haskell
-- 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 #-}
|
|
module WriteTests (tests) where
|
|
|
|
import Test.HUnit
|
|
|
|
import Data.Foldable
|
|
|
|
import Haxl.Core
|
|
import Haxl.Prelude as Haxl
|
|
|
|
newtype SimpleWrite = SimpleWrite Text
|
|
deriving (Eq, Show)
|
|
|
|
doInnerWrite :: GenHaxl u SimpleWrite Int
|
|
doInnerWrite = do
|
|
tellWrite $ SimpleWrite "inner"
|
|
return 0
|
|
|
|
doOuterWrite :: GenHaxl u SimpleWrite Int
|
|
doOuterWrite = do
|
|
tellWrite $ SimpleWrite "outer1"
|
|
|
|
doWriteMemo <- newMemoWith doInnerWrite
|
|
let doMemoizedWrite = runMemo doWriteMemo
|
|
_ <- doMemoizedWrite
|
|
_ <- doMemoizedWrite
|
|
|
|
tellWrite $ SimpleWrite "outer2"
|
|
|
|
return 1
|
|
|
|
doNonMemoWrites :: GenHaxl u SimpleWrite Int
|
|
doNonMemoWrites = do
|
|
tellWrite $ SimpleWrite "inner"
|
|
tellWriteNoMemo $ SimpleWrite "inner not memo"
|
|
return 0
|
|
|
|
writeSoundness :: Test
|
|
writeSoundness = TestCase $ do
|
|
let numReps = 4
|
|
|
|
-- do writes without memoization
|
|
env1 <- emptyEnv ()
|
|
(allRes, allWrites) <- runHaxlWithWrites env1 $
|
|
Haxl.sequence (replicate numReps doInnerWrite)
|
|
|
|
assertBool "Write Soundness 1" $
|
|
allWrites == replicate numReps (SimpleWrite "inner")
|
|
assertBool "Write Soundness 2" $ allRes == replicate numReps 0
|
|
|
|
-- do writes with memoization
|
|
env2 <- emptyEnv ()
|
|
|
|
(memoRes, memoWrites) <- runHaxlWithWrites env2 $ do
|
|
doWriteMemo <- newMemoWith doInnerWrite
|
|
let memoizedWrite = runMemo doWriteMemo
|
|
|
|
Haxl.sequence (replicate numReps memoizedWrite)
|
|
|
|
assertBool "Write Soundness 3" $
|
|
memoWrites == replicate numReps (SimpleWrite "inner")
|
|
assertBool "Write Soundness 4" $ memoRes == replicate numReps 0
|
|
|
|
-- do writes with interleaved memo
|
|
env3 <- emptyEnv ()
|
|
|
|
(ilRes, ilWrites) <- runHaxlWithWrites env3 $ do
|
|
doWriteMemo <- newMemoWith doInnerWrite
|
|
let memoizedWrite = runMemo doWriteMemo
|
|
|
|
Haxl.sequence $ replicate numReps (doInnerWrite *> memoizedWrite)
|
|
|
|
assertBool "Write Soundness 5" $
|
|
ilWrites == replicate (2*numReps) (SimpleWrite "inner")
|
|
assertBool "Write Soundness 6" $ ilRes == replicate numReps 0
|
|
|
|
-- do writes with nested memo
|
|
env4 <- emptyEnv ()
|
|
|
|
(nestRes, nestWrites) <- runHaxlWithWrites env4 $ do
|
|
doWriteMemo' <- newMemoWith doOuterWrite
|
|
let memoizedWrite' = runMemo doWriteMemo'
|
|
|
|
Haxl.sequence (replicate numReps memoizedWrite')
|
|
|
|
let expWrites =
|
|
[ SimpleWrite "outer1"
|
|
, SimpleWrite "inner"
|
|
, SimpleWrite "inner"
|
|
, SimpleWrite "outer2"
|
|
]
|
|
assertBool "Write Soundness 7" $
|
|
nestWrites == fold (replicate numReps expWrites)
|
|
assertBool "Write Soundness 8" $ nestRes == replicate numReps 1
|
|
|
|
-- do both kinds of writes without memoization
|
|
env5 <- emptyEnv ()
|
|
(allRes, allWrites) <- runHaxlWithWrites env5 $
|
|
Haxl.sequence (replicate numReps doNonMemoWrites)
|
|
|
|
assertBool "Write Soundness 9" $
|
|
allWrites == replicate numReps (SimpleWrite "inner") ++
|
|
replicate numReps (SimpleWrite "inner not memo")
|
|
assertBool "Write Soundness 10" $ allRes == replicate numReps 0
|
|
|
|
-- do both kinds of writes with memoization
|
|
env6 <- emptyEnv ()
|
|
|
|
(memoRes, memoWrites) <- runHaxlWithWrites env6 $ do
|
|
doWriteMemo <- newMemoWith doNonMemoWrites
|
|
let memoizedWrite = runMemo doWriteMemo
|
|
|
|
Haxl.sequence (replicate numReps memoizedWrite)
|
|
|
|
-- "inner not memo" only appears once in this test
|
|
assertBool "Write Soundness 11" $
|
|
memoWrites == replicate numReps (SimpleWrite "inner") ++
|
|
[SimpleWrite "inner not memo"]
|
|
assertBool "Write Soundness 12" $ memoRes == replicate numReps 0
|
|
|
|
|
|
|
|
tests = TestList [TestLabel "Write Soundness" writeSoundness]
|