diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 4cadf7c..0ec0e2f 100644 --- a/grpc-haskell.cabal +++ b/grpc-haskell.cabal @@ -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 diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs index 4a570ba..41bebec 100644 --- a/tests/LowLevelTests.hs +++ b/tests/LowLevelTests.hs @@ -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")] diff --git a/tests/Properties.hs b/tests/Properties.hs index 2a105e2..a6345f2 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -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 diff --git a/tests/UnsafeTests.hs b/tests/UnsafeTests.hs new file mode 100644 index 0000000..9a87819 --- /dev/null +++ b/tests/UnsafeTests.hs @@ -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