mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Add Unison.Runtime.Resource pool naive test
Using a hard-coded acquire and release, test that acquire correctly passes along its value.
This commit is contained in:
parent
157b34024b
commit
fccdda89d1
3
node/runtests.sh
Normal file
3
node/runtests.sh
Normal file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
# I always forget this flag
|
||||
cabal test --show-details=streaming
|
15
node/src/Unison/Runtime/ResourcePool.hs
Normal file
15
node/src/Unison/Runtime/ResourcePool.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module Unison.Runtime.ResourcePool where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- acquire returns the resource, and the cleanup action ("finalizer") for that resource
|
||||
data Pool p r = Pool { acquire :: p -> IO (r, IO ()) }
|
||||
|
||||
iacquire :: (p -> IO r) -> p -> IO (r, IO ())
|
||||
iacquire a p = do
|
||||
r <- a p
|
||||
return (r, return ())
|
||||
|
||||
pool :: Ord p => Int -> (p -> IO r) -> (r -> IO ()) -> IO (Pool p r)
|
||||
pool maxPoolSize a release =
|
||||
return $ Pool { acquire = iacquire a }
|
10
node/tests/Suite.hs
Normal file
10
node/tests/Suite.hs
Normal file
@ -0,0 +1,10 @@
|
||||
module Main where
|
||||
|
||||
import Test.Tasty
|
||||
import qualified Unison.Test.ResourcePool as ResourcePool
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "unison" [ResourcePool.tests]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
28
node/tests/Unison/Test/ResourcePool.hs
Normal file
28
node/tests/Unison/Test/ResourcePool.hs
Normal file
@ -0,0 +1,28 @@
|
||||
module Unison.Test.ResourcePool where
|
||||
|
||||
import qualified Unison.Runtime.ResourcePool as RP
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
type Resource = String
|
||||
type Params = String
|
||||
|
||||
fakeAcquire :: Params -> IO Resource
|
||||
fakeAcquire p = return "r1"
|
||||
|
||||
fakeRelease :: Resource -> IO ()
|
||||
fakeRelease r = return ()
|
||||
|
||||
correctlyReturnsTest :: Assertion
|
||||
correctlyReturnsTest = do
|
||||
pool <- (RP.pool 3 fakeAcquire fakeRelease)
|
||||
(r, _) <- RP.acquire pool "p1"
|
||||
assertEqual "the correct resource is returned" "r1" r
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Doc"
|
||||
[
|
||||
testCase "Test" $ correctlyReturnsTest
|
||||
]
|
||||
|
||||
main = defaultMain tests
|
@ -56,6 +56,7 @@ library
|
||||
Unison.Runtime.Pcbt
|
||||
Unison.Runtime.Unfold
|
||||
Unison.Runtime.Vector
|
||||
Unison.Runtime.ResourcePool
|
||||
|
||||
build-depends:
|
||||
aeson,
|
||||
@ -125,3 +126,19 @@ executable node
|
||||
vector,
|
||||
wai-middleware-static,
|
||||
wai-extra
|
||||
|
||||
test-suite tests
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Suite.hs
|
||||
ghc-options: -w -threaded -rtsopts -with-rtsopts=-N -v0
|
||||
hs-source-dirs: tests
|
||||
other-modules:
|
||||
build-depends:
|
||||
base,
|
||||
containers,
|
||||
tasty,
|
||||
tasty-hunit,
|
||||
tasty-smallcheck,
|
||||
tasty-quickcheck,
|
||||
transformers,
|
||||
unison-node
|
@ -1,3 +1,4 @@
|
||||
#!/bin/sh
|
||||
# run 'stack test" to correctly configure this
|
||||
# I always forget this flag
|
||||
cabal test --show-details=streaming
|
||||
|
Loading…
Reference in New Issue
Block a user