Move unsafe C bindings unit tests to UnsafeTests module; minor nit-linting

This commit is contained in:
Joel Stanley 2016-05-24 14:27:15 -07:00
parent f01d19c574
commit a5559cfca4
4 changed files with 116 additions and 102 deletions

View File

@ -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

View File

@ -11,17 +11,17 @@ import Test.Tasty.HUnit ((@?=), testCase)
lowLevelTests :: TestTree lowLevelTests :: TestTree
lowLevelTests = testGroup "Unit tests of low-level Haskell library" lowLevelTests = testGroup "Unit tests of low-level Haskell library"
[ testGRPCBracket [ testGRPCBracket
, testCompletionQueueCreateDestroy , testCompletionQueueCreateDestroy
, testServerCreateDestroy , testServerCreateDestroy
, 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
dummyMeta = M.fromList [("foo","bar")] dummyMeta = M.fromList [("foo","bar")]

View File

@ -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
View 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