mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-14 23:29:42 +01:00
Move unsafe C bindings unit tests to UnsafeTests module; minor nit-linting
This commit is contained in:
parent
f01d19c574
commit
a5559cfca4
4 changed files with 116 additions and 102 deletions
|
@ -76,7 +76,9 @@ test-suite test
|
|||
, tasty >= 0.11 && <0.12
|
||||
, tasty-hunit >= 0.9 && <0.10
|
||||
, containers ==0.5.*
|
||||
other-modules: LowLevelTests
|
||||
other-modules:
|
||||
LowLevelTests,
|
||||
UnsafeTests
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -fwarn-incomplete-patterns -g -threaded
|
||||
hs-source-dirs: tests
|
||||
|
|
|
@ -11,17 +11,17 @@ import Test.Tasty.HUnit ((@?=), testCase)
|
|||
|
||||
lowLevelTests :: TestTree
|
||||
lowLevelTests = testGroup "Unit tests of low-level Haskell library"
|
||||
[ testGRPCBracket
|
||||
, testCompletionQueueCreateDestroy
|
||||
, testServerCreateDestroy
|
||||
, testClientCreateDestroy
|
||||
, testWithServerCall
|
||||
, testWithClientCall
|
||||
--, testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
|
||||
--, testClientRequestNoServer --TODO: succeeds when no other tests run.
|
||||
, testServerAwaitNoClient
|
||||
--, testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
|
||||
]
|
||||
[ testGRPCBracket
|
||||
, testCompletionQueueCreateDestroy
|
||||
, testServerCreateDestroy
|
||||
, testClientCreateDestroy
|
||||
, testWithServerCall
|
||||
, testWithClientCall
|
||||
-- , testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
|
||||
-- , testClientRequestNoServer --TODO: succeeds when no other tests run.
|
||||
, testServerAwaitNoClient
|
||||
-- , testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
|
||||
]
|
||||
|
||||
dummyMeta :: M.Map ByteString ByteString
|
||||
dummyMeta = M.fromList [("foo","bar")]
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import qualified Data.ByteString as B
|
||||
import Foreign.Marshal.Alloc
|
||||
import Foreign.Ptr
|
||||
import Foreign.Storable
|
||||
|
@ -10,67 +9,12 @@ import Network.GRPC.Unsafe.ByteBuffer
|
|||
import Network.GRPC.Unsafe.Constants
|
||||
import Network.GRPC.Unsafe.Metadata
|
||||
import Network.GRPC.Unsafe.Op
|
||||
import Network.GRPC.Unsafe.Slice
|
||||
import Network.GRPC.Unsafe.Time
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit as HU
|
||||
|
||||
import LowLevelTests
|
||||
|
||||
roundtripSlice :: B.ByteString -> TestTree
|
||||
roundtripSlice bs = testCase "Slice C bindings roundtrip" $ do
|
||||
slice <- byteStringToSlice bs
|
||||
unslice <- sliceToByteString slice
|
||||
bs HU.@?= unslice
|
||||
freeSlice slice
|
||||
|
||||
roundtripByteBuffer :: B.ByteString -> TestTree
|
||||
roundtripByteBuffer bs = testCase "ByteBuffer C bindings roundtrip" $ do
|
||||
slice <- byteStringToSlice bs
|
||||
buffer <- grpcRawByteBufferCreate slice 1
|
||||
reader <- byteBufferReaderCreate buffer
|
||||
readSlice <- grpcByteBufferReaderReadall reader
|
||||
bs' <- sliceToByteString readSlice
|
||||
bs' HU.@?= bs
|
||||
--clean up
|
||||
freeSlice slice
|
||||
byteBufferReaderDestroy reader
|
||||
grpcByteBufferDestroy buffer
|
||||
freeSlice readSlice
|
||||
|
||||
currTimeMillis :: ClockType -> IO Int
|
||||
currTimeMillis t = do
|
||||
gprT <- gprNow t
|
||||
tMillis <- gprTimeToMillis gprT
|
||||
timespecDestroy gprT
|
||||
return tMillis
|
||||
|
||||
testNow :: TestTree
|
||||
testNow = testCase "create and destroy various clock types" $ do
|
||||
_ <- currTimeMillis GprClockMonotonic
|
||||
_ <- currTimeMillis GprClockRealtime
|
||||
_ <- currTimeMillis GprClockPrecise
|
||||
return ()
|
||||
|
||||
testMetadata :: TestTree
|
||||
testMetadata = testCase "metadata setter/getter C bindings roundtrip" $ do
|
||||
m <- metadataAlloc 3
|
||||
setMetadataKeyVal "hello" "world" m 0
|
||||
setMetadataKeyVal "foo" "bar" m 1
|
||||
setMetadataKeyVal "Haskell" "Curry" m 2
|
||||
k0 <- getMetadataKey m 0
|
||||
v0 <- getMetadataVal m 0
|
||||
k1 <- getMetadataKey m 1
|
||||
v1 <- getMetadataVal m 1
|
||||
k2 <- getMetadataKey m 2
|
||||
v2 <- getMetadataVal m 2
|
||||
k0 HU.@?= "hello"
|
||||
v0 HU.@?= "world"
|
||||
k1 HU.@?= "foo"
|
||||
v1 HU.@?= "bar"
|
||||
k2 HU.@?= "Haskell"
|
||||
v2 HU.@?= "Curry"
|
||||
metadataFree m
|
||||
import UnsafeTests
|
||||
|
||||
assertCqEventComplete :: Event -> IO ()
|
||||
assertCqEventComplete e = do
|
||||
|
@ -200,45 +144,17 @@ testPayload = testCase "low-level C bindings request/response " $ do
|
|||
grpcInit
|
||||
withAsync testPayloadServer $ \a1 -> do
|
||||
withAsync testPayloadClient $ \a2 -> do
|
||||
() <- wait a1
|
||||
wait a1
|
||||
wait a2
|
||||
grpcShutdown
|
||||
putStrLn "Done."
|
||||
|
||||
testCreateDestroyMetadata :: TestTree
|
||||
testCreateDestroyMetadata = testCase "create/destroy metadataArrayPtr " $ do
|
||||
grpcInit
|
||||
withMetadataArrayPtr $ const (return ())
|
||||
grpcShutdown
|
||||
|
||||
testCreateDestroyMetadataKeyVals :: TestTree
|
||||
testCreateDestroyMetadataKeyVals = testCase "create/destroy metadata k/vs " $ do
|
||||
grpcInit
|
||||
withMetadataKeyValPtr 10 $ const (return ())
|
||||
grpcShutdown
|
||||
|
||||
testCreateDestroyDeadline :: TestTree
|
||||
testCreateDestroyDeadline = testCase "create/destroy deadline " $ do
|
||||
grpcInit
|
||||
withDeadlineSeconds 10 $ const (return ())
|
||||
grpcShutdown
|
||||
|
||||
unsafeTests :: TestTree
|
||||
unsafeTests = testGroup "Unit tests for unsafe C bindings."
|
||||
[testPayload,
|
||||
roundtripSlice "Hello, world!",
|
||||
roundtripByteBuffer "Hwaet! We gardena in geardagum...",
|
||||
testMetadata,
|
||||
testNow,
|
||||
testCreateDestroyMetadata,
|
||||
testCreateDestroyMetadataKeyVals,
|
||||
testCreateDestroyDeadline
|
||||
]
|
||||
|
||||
allTests :: TestTree
|
||||
allTests = testGroup "All tests"
|
||||
[ unsafeTests,
|
||||
lowLevelTests]
|
||||
[ testPayload
|
||||
, unsafeTests
|
||||
, lowLevelTests
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain allTests
|
||||
|
|
96
tests/UnsafeTests.hs
Normal file
96
tests/UnsafeTests.hs
Normal file
|
@ -0,0 +1,96 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module UnsafeTests where
|
||||
|
||||
import Data.ByteString as B (ByteString)
|
||||
import Network.GRPC.Unsafe
|
||||
import Network.GRPC.Unsafe.ByteBuffer
|
||||
import Network.GRPC.Unsafe.Metadata
|
||||
import Network.GRPC.Unsafe.Slice
|
||||
import Network.GRPC.Unsafe.Time
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
||||
|
||||
unsafeTests :: TestTree
|
||||
unsafeTests = testGroup "Unit tests for unsafe C bindings."
|
||||
[ roundtripSlice "Hello, world!"
|
||||
, roundtripByteBuffer "Hwaet! We gardena in geardagum..."
|
||||
, testMetadata
|
||||
, testNow
|
||||
, testCreateDestroyMetadata
|
||||
, testCreateDestroyMetadataKeyVals
|
||||
, testCreateDestroyDeadline
|
||||
]
|
||||
|
||||
roundtripSlice :: B.ByteString -> TestTree
|
||||
roundtripSlice bs = testCase "Slice C bindings roundtrip" $ do
|
||||
slice <- byteStringToSlice bs
|
||||
unslice <- sliceToByteString slice
|
||||
bs HU.@?= unslice
|
||||
freeSlice slice
|
||||
|
||||
roundtripByteBuffer :: B.ByteString -> TestTree
|
||||
roundtripByteBuffer bs = testCase "ByteBuffer C bindings roundtrip" $ do
|
||||
slice <- byteStringToSlice bs
|
||||
buffer <- grpcRawByteBufferCreate slice 1
|
||||
reader <- byteBufferReaderCreate buffer
|
||||
readSlice <- grpcByteBufferReaderReadall reader
|
||||
bs' <- sliceToByteString readSlice
|
||||
bs' HU.@?= bs
|
||||
-- clean up
|
||||
freeSlice slice
|
||||
byteBufferReaderDestroy reader
|
||||
grpcByteBufferDestroy buffer
|
||||
freeSlice readSlice
|
||||
|
||||
testMetadata :: TestTree
|
||||
testMetadata = testCase "metadata setter/getter C bindings roundtrip" $ do
|
||||
m <- metadataAlloc 3
|
||||
setMetadataKeyVal "hello" "world" m 0
|
||||
setMetadataKeyVal "foo" "bar" m 1
|
||||
setMetadataKeyVal "Haskell" "Curry" m 2
|
||||
k0 <- getMetadataKey m 0
|
||||
v0 <- getMetadataVal m 0
|
||||
k1 <- getMetadataKey m 1
|
||||
v1 <- getMetadataVal m 1
|
||||
k2 <- getMetadataKey m 2
|
||||
v2 <- getMetadataVal m 2
|
||||
k0 HU.@?= "hello"
|
||||
v0 HU.@?= "world"
|
||||
k1 HU.@?= "foo"
|
||||
v1 HU.@?= "bar"
|
||||
k2 HU.@?= "Haskell"
|
||||
v2 HU.@?= "Curry"
|
||||
metadataFree m
|
||||
|
||||
currTimeMillis :: ClockType -> IO Int
|
||||
currTimeMillis t = do
|
||||
gprT <- gprNow t
|
||||
tMillis <- gprTimeToMillis gprT
|
||||
timespecDestroy gprT
|
||||
return tMillis
|
||||
|
||||
testNow :: TestTree
|
||||
testNow = testCase "create and destroy various clock types" $ do
|
||||
_ <- currTimeMillis GprClockMonotonic
|
||||
_ <- currTimeMillis GprClockRealtime
|
||||
_ <- currTimeMillis GprClockPrecise
|
||||
return ()
|
||||
|
||||
testCreateDestroyMetadata :: TestTree
|
||||
testCreateDestroyMetadata = testCase "create/destroy metadataArrayPtr " $ do
|
||||
grpcInit
|
||||
withMetadataArrayPtr $ const $ return ()
|
||||
grpcShutdown
|
||||
|
||||
testCreateDestroyMetadataKeyVals :: TestTree
|
||||
testCreateDestroyMetadataKeyVals = testCase "create/destroy metadata k/vs " $ do
|
||||
grpcInit
|
||||
withMetadataKeyValPtr 10 $ const $ return ()
|
||||
grpcShutdown
|
||||
|
||||
testCreateDestroyDeadline :: TestTree
|
||||
testCreateDestroyDeadline = testCase "create/destroy deadline " $ do
|
||||
grpcInit
|
||||
withDeadlineSeconds 10 $ const $ return ()
|
||||
grpcShutdown
|
Loading…
Reference in a new issue