Repository: thrift Updated Branches: refs/heads/master 0156aaed1 -> dfb689643
THRIFT-3433 Doubles aren't interpreted correctly Client: Haskell Patch: Nobuaki Sukegawa This closes #736 Project: http://git-wip-us.apache.org/repos/asf/thrift/repo Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/7c7d679a Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/7c7d679a Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/7c7d679a Branch: refs/heads/master Commit: 7c7d679a127ed5157464b061a7f9bfd40ad2f1fa Parents: 4f6138b Author: Nobuaki Sukegawa <ns...@apache.org> Authored: Wed Dec 9 03:22:35 2015 +0900 Committer: Nobuaki Sukegawa <ns...@apache.org> Committed: Fri Dec 11 00:18:01 2015 +0900 ---------------------------------------------------------------------- lib/hs/CMakeLists.txt | 28 ++++++++--- lib/hs/LICENSE | 0 lib/hs/Makefile.am | 4 ++ lib/hs/README.md | 0 lib/hs/TODO | 0 lib/hs/Thrift.cabal | 8 ++++ lib/hs/src/Thrift/Protocol.hs | 22 +++++---- lib/hs/src/Thrift/Protocol/Compact.hs | 10 ++-- lib/hs/src/Thrift/Transport/Memory.hs | 77 ++++++++++++++++++++++++++++++ lib/hs/test/BinarySpec.hs | 68 ++++++++++++++++++++++++++ lib/hs/test/CompactSpec.hs | 58 ++++++++++++++++++++++ lib/hs/test/Spec.hs | 36 ++++++++++++++ 12 files changed, 291 insertions(+), 20 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/CMakeLists.txt ---------------------------------------------------------------------- diff --git a/lib/hs/CMakeLists.txt b/lib/hs/CMakeLists.txt index 37ea288..b5d1d20 100644 --- a/lib/hs/CMakeLists.txt +++ b/lib/hs/CMakeLists.txt @@ -36,6 +36,15 @@ set(haskell_sources Thrift.cabal ) +if(BUILD_TESTING) + list(APPEND haskell_soruces + test/Spec.hs + test/BinarySpec.hs + test/CompactSpec.hs + ) + set(hs_enable_test "--enable-tests") +endif() + set(haskell_artifacts thrift_cabal.stamp) # Adding *.hi files so that any missing file triggers the build foreach(SRC ${haskell_sources}) @@ -48,18 +57,19 @@ foreach(SRC ${haskell_sources}) endif() endforeach() -if (CMAKE_BUILD_TYPE STREQUAL "Debug") - set(hs_optimize -O0) +if(CMAKE_BUILD_TYPE STREQUAL "Debug") + set(hs_optimize -O0) elseif(CMAKE_BUILD_TYPE STREQUAL "Release") - set(hs_optimize -O1) + set(hs_optimize -O1) endif() add_custom_command( OUTPUT ${haskell_artifacts} COMMAND ${CABAL} update # Build dependencies first without --builddir, otherwise it fails. - COMMAND ${CABAL} install --only-dependencies - COMMAND ${CABAL} configure ${hs_optimize} + COMMAND ${CABAL} install --only-dependencies ${hs_enable_test} + COMMAND ${CABAL} configure ${hs_optimize} ${hs_enable_test} --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist + COMMAND ${CABAL} build --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist COMMAND ${CABAL} install --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist COMMAND ${CMAKE_COMMAND} -E touch ${CMAKE_CURRENT_BINARY_DIR}/thrift_cabal.stamp WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} @@ -70,7 +80,13 @@ add_custom_target(haskell_library ALL DEPENDS ${haskell_artifacts}) if(BUILD_TESTING) - add_test(NAME CabalCheck + add_test(NAME HaskellCabalCheck COMMAND ${CABAL} check WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) + add_test(NAME HaskellCabalTest + # Cabal fails to find built executable when --builddir is specified. + # So we invoke the executable directly. + # COMMAND ${CABAL} test --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist + # WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) + COMMAND dist/build/spec/spec) endif() http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/LICENSE ---------------------------------------------------------------------- diff --git a/lib/hs/LICENSE b/lib/hs/LICENSE old mode 100755 new mode 100644 http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/Makefile.am ---------------------------------------------------------------------- diff --git a/lib/hs/Makefile.am b/lib/hs/Makefile.am old mode 100755 new mode 100644 index 45529c7..543381f --- a/lib/hs/Makefile.am +++ b/lib/hs/Makefile.am @@ -42,3 +42,7 @@ maintainer-clean-local: check-local: $(CABAL) check + $(CABAL) install --only-dependencies --enable-tests + $(CABAL) configure --enable-tests + $(CABAL) build + $(CABAL) test http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/README.md ---------------------------------------------------------------------- diff --git a/lib/hs/README.md b/lib/hs/README.md old mode 100755 new mode 100644 http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/TODO ---------------------------------------------------------------------- diff --git a/lib/hs/TODO b/lib/hs/TODO old mode 100755 new mode 100644 http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/Thrift.cabal ---------------------------------------------------------------------- diff --git a/lib/hs/Thrift.cabal b/lib/hs/Thrift.cabal old mode 100755 new mode 100644 index 5610a5c..f0a09aa --- a/lib/hs/Thrift.cabal +++ b/lib/hs/Thrift.cabal @@ -59,6 +59,7 @@ Library Thrift.Transport.Handle, Thrift.Transport.HttpClient, Thrift.Transport.IOBuffer, + Thrift.Transport.Memory, Thrift.Types Extensions: DeriveDataTypeable, @@ -70,3 +71,10 @@ Library RecordWildCards, ScopedTypeVariables, TypeSynonymInstances + +Test-Suite spec + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: test + Ghc-Options: -Wall + main-is: Spec.hs + Build-Depends: base, thrift, hspec, QuickCheck, bytestring >= 0.10, unordered-containers http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/src/Thrift/Protocol.hs ---------------------------------------------------------------------- diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs index ea58642..31e48b5 100644 --- a/lib/hs/src/Thrift/Protocol.hs +++ b/lib/hs/src/Thrift/Protocol.hs @@ -29,6 +29,7 @@ module Thrift.Protocol , versionMask , version1 , bsToDouble + , bsToDoubleLE ) where import Control.Exception @@ -119,18 +120,22 @@ handleEOF = const $ return mempty -- therefore the behavior of this function varies based on whether the local -- machine is big endian or little endian. bsToDouble :: BS.ByteString -> Double -bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs - where +bsToDoubleLE :: BS.ByteString -> Double #if __BYTE_ORDER == __LITTLE_ENDIAN - castBs chrPtr = do - w <- peek (castPtr chrPtr) - poke (castPtr chrPtr) (byteSwap w) - peek (castPtr chrPtr) +bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped +bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs #else - castBs = peek . castPtr +bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs +bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped #endif -#if __BYTE_ORDER == __LITTLE_ENDIAN + +castBsSwapped chrPtr = do + w <- peek (castPtr chrPtr) + poke (castPtr chrPtr) (byteSwap w) + peek (castPtr chrPtr) +castBs = peek . castPtr + -- | Swap endianness of a 64-bit word byteSwap :: Word64 -> Word64 byteSwap w = (w `shiftL` 56 .&. 0xFF00000000000000) .|. @@ -141,4 +146,3 @@ byteSwap w = (w `shiftL` 56 .&. 0xFF00000000000000) .|. (w `shiftR` 24 .&. 0x0000000000FF0000) .|. (w `shiftR` 40 .&. 0x000000000000FF00) .|. (w `shiftR` 56 .&. 0x00000000000000FF) -#endif http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/src/Thrift/Protocol/Compact.hs ---------------------------------------------------------------------- diff --git a/lib/hs/src/Thrift/Protocol/Compact.hs b/lib/hs/src/Thrift/Protocol/Compact.hs index a329f4e..759466b 100644 --- a/lib/hs/src/Thrift/Protocol/Compact.hs +++ b/lib/hs/src/Thrift/Protocol/Compact.hs @@ -55,7 +55,7 @@ import qualified Data.Text.Lazy as LT data CompactProtocol a = CompactProtocol a -- ^ Constuct a 'CompactProtocol' with a 'Transport' -protocolID, version, typeMask :: Int8 +protocolID, version, versionMask, typeMask, typeBits :: Word8 protocolID = 0x82 -- 1000 0010 version = 0x01 versionMask = 0x1f -- 0001 1111 @@ -69,8 +69,8 @@ instance Protocol CompactProtocol where getTransport (CompactProtocol t) = t writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $ - B.int8 protocolID <> - B.int8 ((version .&. versionMask) .|. + B.word8 protocolID <> + B.word8 ((version .&. versionMask) .|. (((fromIntegral $ fromEnum t) `shiftL` typeShiftAmount) .&. typeMask)) <> buildVarint (i32ToZigZag s) <> @@ -120,7 +120,7 @@ buildCompactValue (TByte b) = int8 b buildCompactValue (TI16 i) = buildVarint $ i16ToZigZag i buildCompactValue (TI32 i) = buildVarint $ i32ToZigZag i buildCompactValue (TI64 i) = buildVarint $ i64ToZigZag i -buildCompactValue (TDouble d) = doubleBE d +buildCompactValue (TDouble d) = doubleLE d buildCompactValue (TString s) = buildVarint len <> lazyByteString s where len = fromIntegral (LBS.length s) :: Word32 @@ -163,7 +163,7 @@ parseCompactValue T_BYTE = TByte . fromIntegral <$> P.anyWord8 parseCompactValue T_I16 = TI16 <$> parseVarint zigZagToI16 parseCompactValue T_I32 = TI32 <$> parseVarint zigZagToI32 parseCompactValue T_I64 = TI64 <$> parseVarint zigZagToI64 -parseCompactValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8 +parseCompactValue T_DOUBLE = TDouble . bsToDoubleLE <$> P.take 8 parseCompactValue T_STRING = do len :: Word32 <- parseVarint id TString . LBS.fromStrict <$> P.take (fromIntegral len) http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/src/Thrift/Transport/Memory.hs ---------------------------------------------------------------------- diff --git a/lib/hs/src/Thrift/Transport/Memory.hs b/lib/hs/src/Thrift/Transport/Memory.hs new file mode 100644 index 0000000..1c93af6 --- /dev/null +++ b/lib/hs/src/Thrift/Transport/Memory.hs @@ -0,0 +1,77 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +module Thrift.Transport.Memory + ( openMemoryBuffer + , MemoryBuffer(..) + ) where + +import Data.ByteString.Lazy.Builder +import Data.Functor +import Data.IORef +import Data.Monoid +import qualified Data.ByteString.Lazy as LBS + +import Thrift.Transport + + +data MemoryBuffer = MemoryBuffer { + writeBuffer :: IORef Builder, + readBuffer :: IORef LBS.ByteString +} + +openMemoryBuffer :: IO MemoryBuffer +openMemoryBuffer = do + wbuf <- newIORef mempty + rbuf <- newIORef mempty + return MemoryBuffer { + writeBuffer = wbuf, + readBuffer = rbuf + } + +instance Transport MemoryBuffer where + tIsOpen = const $ return False + tClose = const $ return () + tFlush trans = do + let wBuf = writeBuffer trans + wb <- readIORef wBuf + modifyIORef (readBuffer trans) $ \rb -> mappend rb $ toLazyByteString wb + writeIORef wBuf mempty + + tRead _ 0 = return mempty + tRead trans n = do + let rbuf = readBuffer trans + rb <- readIORef rbuf + let len = fromIntegral $ LBS.length rb + if len == 0 + then do + tFlush trans + rb2 <- readIORef (readBuffer trans) + if (fromIntegral $ LBS.length rb2) == 0 + then return mempty + else tRead trans n + else do + let (ret, remain) = LBS.splitAt (fromIntegral n) rb + writeIORef rbuf remain + return ret + + tPeek trans = (fmap fst . LBS.uncons) <$> readIORef (readBuffer trans) + + tWrite trans v = do + modifyIORef (writeBuffer trans) (<> lazyByteString v) http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/test/BinarySpec.hs ---------------------------------------------------------------------- diff --git a/lib/hs/test/BinarySpec.hs b/lib/hs/test/BinarySpec.hs new file mode 100644 index 0000000..5039610 --- /dev/null +++ b/lib/hs/test/BinarySpec.hs @@ -0,0 +1,68 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +module BinarySpec where + +import Test.Hspec +import Test.Hspec.QuickCheck (prop) + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as C + +import Thrift.Types +import Thrift.Transport +import Thrift.Transport.Memory +import Thrift.Protocol +import Thrift.Protocol.Binary + +spec :: Spec +spec = do + describe "BinaryProtocol" $ do + describe "double" $ do + it "writes in big endian order" $ do + let val = 2 ** 53 + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + writeVal proto (TDouble val) + bin <- tRead trans 8 + (LBS.unpack bin) `shouldBe`[67, 64, 0, 0, 0, 0, 0, 0] + + it "reads in big endian order" $ do + let bin = LBS.pack [67, 64, 0, 0, 0, 0, 0, 0] + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + tWrite trans bin + val <- readVal proto T_DOUBLE + val `shouldBe` (TDouble $ 2 ** 53) + + prop "round trip" $ \val -> do + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + writeVal proto $ TDouble val + val2 <- readVal proto T_DOUBLE + val2 `shouldBe` (TDouble val) + + describe "string" $ do + it "writes" $ do + let val = C.pack "aaa" + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + writeVal proto (TString val) + bin <- tRead trans 7 + (LBS.unpack bin) `shouldBe` [0, 0, 0, 3, 97, 97, 97] http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/test/CompactSpec.hs ---------------------------------------------------------------------- diff --git a/lib/hs/test/CompactSpec.hs b/lib/hs/test/CompactSpec.hs new file mode 100644 index 0000000..22708b4 --- /dev/null +++ b/lib/hs/test/CompactSpec.hs @@ -0,0 +1,58 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +module CompactSpec where + +import Test.Hspec +import Test.Hspec.QuickCheck (prop) + +import qualified Data.ByteString.Lazy as LBS + +import Thrift.Types +import Thrift.Transport +import Thrift.Transport.Memory +import Thrift.Protocol +import Thrift.Protocol.Compact + +spec :: Spec +spec = do + describe "CompactProtocol" $ do + describe "double" $ do + it "writes in little endian order" $ do + let val = 2 ** 53 + trans <- openMemoryBuffer + let proto = CompactProtocol trans + writeVal proto (TDouble val) + bin <- tReadAll trans 8 + (LBS.unpack bin) `shouldBe`[0, 0, 0, 0, 0, 0, 64, 67] + + it "reads in little endian order" $ do + let bin = LBS.pack [0, 0, 0, 0, 0, 0, 64, 67] + trans <- openMemoryBuffer + let proto = CompactProtocol trans + tWrite trans bin + val <- readVal proto T_DOUBLE + val `shouldBe` (TDouble $ 2 ** 53) + + prop "round trip" $ \val -> do + trans <- openMemoryBuffer + let proto = CompactProtocol trans + writeVal proto $ TDouble val + val2 <- readVal proto T_DOUBLE + val2 `shouldBe` (TDouble val) http://git-wip-us.apache.org/repos/asf/thrift/blob/7c7d679a/lib/hs/test/Spec.hs ---------------------------------------------------------------------- diff --git a/lib/hs/test/Spec.hs b/lib/hs/test/Spec.hs new file mode 100644 index 0000000..0f5a816 --- /dev/null +++ b/lib/hs/test/Spec.hs @@ -0,0 +1,36 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +-- Our CI does not work well with auto discover. +-- Need to add build-time PATH variable to hspec-discover dir from CMake +-- or install hspec system-wide for the following to work. +-- {-# OPTIONS_GHC -F -pgmF hspec-discover #-} + +import Test.Hspec + +import qualified BinarySpec +import qualified CompactSpec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Binary" BinarySpec.spec + describe "Compact" CompactSpec.spec
