THRIFT-3433 Doubles aren't interpreted correctly
Client: Haskell
Patch: Nobuaki Sukegawa
This closes #736
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]
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)
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