mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-25 17:53:34 +03:00
8a69ddcc0d
Summary: GHC prior to 7.10 didn't export <$> in the prelude. Reviewed By: watashi Differential Revision: D3659220 fbshipit-source-id: af95574bc33f593fe0deb9217a963a7d9d9b0a16
75 lines
1.9 KiB
Haskell
75 lines
1.9 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
module MemoizationTests (tests) where
|
|
|
|
#if __GLASGOW_HASKELL__ < 710
|
|
import Control.Applicative
|
|
#endif
|
|
import Data.IORef
|
|
|
|
import Test.HUnit
|
|
|
|
import Haxl.Core
|
|
import Haxl.Core.Monad
|
|
|
|
import ExampleDataSource
|
|
|
|
memoSoundness :: Test
|
|
memoSoundness = TestCase $ do
|
|
iEnv <- do
|
|
exState <- ExampleDataSource.initGlobalState
|
|
initEnv (stateSet exState stateEmpty) ()
|
|
|
|
unMemoizedWombats <- runHaxl iEnv $ listWombats 100
|
|
|
|
(initialGet, subsequentGet) <- runHaxl iEnv $ do
|
|
wombatsMemo <- newMemoWith (listWombats 100)
|
|
let memoizedWombats = runMemo wombatsMemo
|
|
|
|
initialGet <- memoizedWombats
|
|
subsequentGet <- memoizedWombats
|
|
|
|
return (initialGet, subsequentGet)
|
|
|
|
assertBool "Memo Soundness 1" $ initialGet == unMemoizedWombats
|
|
assertBool "Memo Soundness 2" $ subsequentGet == unMemoizedWombats
|
|
|
|
let impure runCounterRef = unsafeLiftIO $ do
|
|
modifyIORef runCounterRef succ
|
|
readIORef runCounterRef
|
|
|
|
initialRunCounter = 0 :: Int
|
|
|
|
runCounterRef <- newIORef initialRunCounter
|
|
|
|
(initialImpureGet, subsequentImpureGet) <- runHaxl iEnv $ do
|
|
impureMemo <- newMemoWith (impure runCounterRef)
|
|
let memoizedImpure = runMemo impureMemo
|
|
|
|
initialImpureGet <- memoizedImpure
|
|
subsequentImpureGet <- memoizedImpure
|
|
|
|
return (initialImpureGet, subsequentImpureGet)
|
|
|
|
assertBool "Memo Soundness 3" $ initialImpureGet == succ initialRunCounter
|
|
assertBool "Memo Soundness 4" $ subsequentImpureGet == initialImpureGet
|
|
|
|
let fMemoVal = 42 :: Int
|
|
|
|
dependentResult <- runHaxl iEnv $ do
|
|
fMemoRef <- newMemo
|
|
gMemoRef <- newMemo
|
|
|
|
let f = runMemo fMemoRef
|
|
g = runMemo gMemoRef
|
|
|
|
prepareMemo fMemoRef $ return fMemoVal
|
|
prepareMemo gMemoRef $ succ <$> f
|
|
|
|
a <- f
|
|
b <- g
|
|
return (a + b)
|
|
|
|
assertBool "Memo Soundness 5" $ dependentResult == fMemoVal + succ fMemoVal
|
|
|
|
tests = TestList [TestLabel "Memo Soundness" memoSoundness]
|