mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-04 18: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 >= 0.11 && <0.12
|
||||||
, tasty-hunit >= 0.9 && <0.10
|
, tasty-hunit >= 0.9 && <0.10
|
||||||
, containers ==0.5.*
|
, containers ==0.5.*
|
||||||
other-modules: LowLevelTests
|
other-modules:
|
||||||
|
LowLevelTests,
|
||||||
|
UnsafeTests
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -fwarn-incomplete-patterns -g -threaded
|
ghc-options: -Wall -fwarn-incomplete-patterns -g -threaded
|
||||||
hs-source-dirs: tests
|
hs-source-dirs: tests
|
||||||
|
|
|
@ -17,10 +17,10 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
|
||||||
, testClientCreateDestroy
|
, testClientCreateDestroy
|
||||||
, testWithServerCall
|
, testWithServerCall
|
||||||
, testWithClientCall
|
, testWithClientCall
|
||||||
--, testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
|
-- , testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
|
||||||
--, testClientRequestNoServer --TODO: succeeds when no other tests run.
|
-- , testClientRequestNoServer --TODO: succeeds when no other tests run.
|
||||||
, testServerAwaitNoClient
|
, testServerAwaitNoClient
|
||||||
--, testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
|
-- , testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
|
||||||
]
|
]
|
||||||
|
|
||||||
dummyMeta :: M.Map ByteString ByteString
|
dummyMeta :: M.Map ByteString ByteString
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import Foreign.Marshal.Alloc
|
import Foreign.Marshal.Alloc
|
||||||
import Foreign.Ptr
|
import Foreign.Ptr
|
||||||
import Foreign.Storable
|
import Foreign.Storable
|
||||||
|
@ -10,67 +9,12 @@ import Network.GRPC.Unsafe.ByteBuffer
|
||||||
import Network.GRPC.Unsafe.Constants
|
import Network.GRPC.Unsafe.Constants
|
||||||
import Network.GRPC.Unsafe.Metadata
|
import Network.GRPC.Unsafe.Metadata
|
||||||
import Network.GRPC.Unsafe.Op
|
import Network.GRPC.Unsafe.Op
|
||||||
import Network.GRPC.Unsafe.Slice
|
|
||||||
import Network.GRPC.Unsafe.Time
|
import Network.GRPC.Unsafe.Time
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit as HU
|
import Test.Tasty.HUnit as HU
|
||||||
|
|
||||||
import LowLevelTests
|
import LowLevelTests
|
||||||
|
import UnsafeTests
|
||||||
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
|
|
||||||
|
|
||||||
assertCqEventComplete :: Event -> IO ()
|
assertCqEventComplete :: Event -> IO ()
|
||||||
assertCqEventComplete e = do
|
assertCqEventComplete e = do
|
||||||
|
@ -200,45 +144,17 @@ testPayload = testCase "low-level C bindings request/response " $ do
|
||||||
grpcInit
|
grpcInit
|
||||||
withAsync testPayloadServer $ \a1 -> do
|
withAsync testPayloadServer $ \a1 -> do
|
||||||
withAsync testPayloadClient $ \a2 -> do
|
withAsync testPayloadClient $ \a2 -> do
|
||||||
() <- wait a1
|
wait a1
|
||||||
wait a2
|
wait a2
|
||||||
grpcShutdown
|
grpcShutdown
|
||||||
putStrLn "Done."
|
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 :: TestTree
|
||||||
allTests = testGroup "All tests"
|
allTests = testGroup "All tests"
|
||||||
[ unsafeTests,
|
[ testPayload
|
||||||
lowLevelTests]
|
, unsafeTests
|
||||||
|
, lowLevelTests
|
||||||
|
]
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain allTests
|
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