bert 1.2.2.4 → 1.2.2.5

raw patch · 4 files changed

+103/−6 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• bert.cabal +1/−1
• src/Data/BERT/Term.hs +16/−3
• tests/test.hs +80/−2

@@ -1,3 +1,9 @@+Version 1.2.2.5+---------------++* Fix a list deserialization bug+* Serialize small ints compactly+ Version 1.2.2.4 --------------- 

@@ -1,6 +1,6 @@ cabal-version: >= 1.16 name:          bert-version:       1.2.2.4+version:       1.2.2.5 build-type:    Simple license:       BSD3 license-file:  LICENSE

@@ -177,7 +177,9 @@  -- | Binary encoding of a single term (without header) putTerm :: Term -> PutM ()-putTerm (IntTerm value) = tag 98 >> put32s value+putTerm (IntTerm value)+  | 0 <= value && value < 256 = tag 97 >> put8u value+  | otherwise                 = tag 98 >> put32s value putTerm (FloatTerm value) =   tag 99 >> (putL . C.pack . pad $ printf "%15.15e" value)   where@@ -203,7 +205,7 @@   where     len = B.length value putTerm (ListTerm value)-  | len == 0 = putNil  -- this is mentioend in the BERT spec.+  | len == 0 = putNil  -- this is mentioned in the BERT spec.   | otherwise= do       tag 108       put32u $ length value@@ -231,12 +233,19 @@     105 -> get32u >>= getN >>= tupleTerm     106 -> return $ ListTerm []     107 -> get16u >>= getL >>= return . BytelistTerm-    108 -> get32u >>= getN >>= return . ListTerm+    108 -> get32u >>= \n -> getN n <* expectNil >>= return . ListTerm     109 -> get32u >>= getL >>= return . BinaryTerm     110 -> getBigint get8u >>= return . BigintTerm . fromIntegral     111 -> getBigint get32u >>= return . BigintTerm . fromIntegral   where+    getN :: Int -> Get [Term]     getN n = replicateM n getTerm+    expectNil :: Get ()+    expectNil = do+      tag <- get8u+      case tag of+        106 -> return ()+        _   -> fail $ "invalid list - expected list ending with Nil"     -- First try & decode composite terms.     tupleTerm [AtomTerm "bert", AtomTerm "true"]  = return $ BoolTerm True     tupleTerm [AtomTerm "bert", AtomTerm "false"] = return $ BoolTerm False@@ -304,9 +313,13 @@ put32s = putWord32be . (fromIntegral :: Int32 -> Word32) . fromIntegral putL = putLazyByteString +get8u :: (Integral a) => Get a get8u  = fromIntegral <$> getWord8+get16u :: (Integral a) => Get a get16u = fromIntegral <$> getWord16be+get32u :: (Integral a) => Get a get32u = fromIntegral <$> getWord32be+get32s :: (Integral a) => Get a get32s = fromIntegral . (fromIntegral :: Word32 -> Int32) <$> getWord32be getL :: (Integral a) => a -> Get ByteString getL = getLazyByteString . fromIntegral

@@ -1,9 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}  import Control.Monad  import Data.Binary-import Data.Char (chr)+import Data.Char (chr, ord)+import Data.List (genericLength) import Data.Map (Map) import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map@@ -42,16 +43,22 @@     else Left  $ printf "%s /= %s" sx sy  -- value -> Term -> encoded -> Term -> value+t :: (BERT a, Eq a, Show a) => T a t a = Right a `eqVerbose` (readBERT . decode . encode . showBERT) a+ -- value -> Term -> Packet -> encoded -> Packet -> Term -> value+p :: (BERT a, Eq a, Show a) => T a p a = Right a `eqVerbose` (readBERT . fromPacket . decode . encode . Packet . showBERT) a +main :: IO () main = defaultMain $ localOption (SmallCheckDepth 4) $   testGroup "Tests"     [ testGroup "Serialization" [simpleTerms, simplePackets]     , networkTests+    , testGroup "Specification compliance" specTests     ] +simpleTerms :: TestTree simpleTerms = testGroup "Simple terms"   [ testProperty "Bool" (t :: T Bool)   , testProperty "Integer" (t :: T Integer)@@ -64,6 +71,7 @@   , testProperty "(Int, Int, Int, Int)" (t :: T (Int, Int, Int, Int))   ] +simplePackets :: TestTree simplePackets = testGroup "Simple packets"   [ testProperty "Bool" (p :: T Bool)   , testProperty "Integer" (p :: T Integer)@@ -75,6 +83,7 @@   , testProperty "(String, Int, Int, Int)" (p :: T (String, Int, Int, Int))   ] +networkTests :: TestTree networkTests = testGroup "Network"   [ networkTest1   , networkTest2@@ -88,6 +97,7 @@ delay :: IO () delay = threadDelay (10^5) +networkTest1 :: TestTree networkTest1 = testCase "Simple call" $ do   t <- tcpServer port   let server = serve t $ \ "mod" "f" [IntTerm a] -> return $ Success $ IntTerm (a+1)@@ -97,6 +107,7 @@     result <- call c "mod" "f" [IntTerm 3]     result @?= Right (IntTerm 4) +networkTest2 :: TestTree networkTest2 = testCase "5 calls per connection" $ do   t <- tcpServer port   let server = serve t $ \ "mod" "f" [IntTerm a, IntTerm b] -> return $ Success $ IntTerm (a+b)@@ -107,6 +118,7 @@       result <- call c "mod" "f" [IntTerm 3, IntTerm x]       result @?= Right (IntTerm (3+x)) +networkTest3 :: TestTree networkTest3 = testCase "5 sequential connections" $ do   t <- tcpServer port   let server = serve t $ \ "mod" "f" [IntTerm a, IntTerm b] -> return $ Success $ IntTerm (a+b)@@ -117,6 +129,7 @@       result <- call c "mod" "f" [IntTerm 3, IntTerm x]       result @?= Right (IntTerm (3+x)) +networkTest4 :: TestTree networkTest4 = testCase "100 simultaneous connections" $ do   t <- tcpServer port   let server = serve t $ \ "mod" "f" [IntTerm a, IntTerm b] ->@@ -132,3 +145,68 @@           result <- call c "mod" "f" [IntTerm 3, IntTerm x]           result @?= Right (IntTerm (3+x))   maybe (assertFailure "Timed out!") (const $ return ()) r++ord' :: Char -> Word8+ord' = fromIntegral . ord++-- Test internal representation according to specification+-- http://erlang.org/doc/apps/erts/erl_ext_dist.html+specTests :: [TestTree]+specTests =+  [ thereAndBackAgainTest "SMAL_INTEGER_EXT" (IntTerm 5) [131, 97, 5]+  , thereAndBackAgainTest "INTEGER_EXT" (IntTerm 0x400) [131, 98, 0, 0, 4, 0]+  , thereAndBackAgainTest "ATOM_EXT"+      (AtomTerm "foobar")+      ([131, 100, 0, 6] ++ map ord' "foobar")+  , thereAndBackAgainTest "SMALL_TUPLE_EXT"+      (TupleTerm+         [ AtomTerm x+         | x <- ["a", "b", "c", "d"]+         ])+      ([131, 104, 4] +++       concat [ [100, 0, genericLength x] ++ map ord' x+              | x <- ["a", "b", "c", "d"]+              ])+  , thereAndBackAgainTest "LARGE_TUPLE_EXT"+      (TupleTerm+         [ AtomTerm [x]+         | x <- take 512 $ cycle ['a'..'z']+         ])+      ([131, 105, 0, 0, 2, 0] +++       concat [ [100, 0, 1, ord' x]+              | x <- take 512 $ cycle ['a'..'z']+              ])+  , thereAndBackAgainTest "NIL_EXT"+      (ListTerm [])+      [131, 106]+  , thereAndBackAgainTest "STRING_EXT"+      (BytelistTerm "abc\0")+      [131, 107, 0, 4, 97, 98, 99, 0]+  , thereAndBackAgainTest "LIST_EXT"+      (ListTerm [AtomTerm "abc", AtomTerm "xyz"])+      ([131, 108, 0, 0, 0, 2] +++       [100, 0, 3, 97, 98, 99] +++       [100, 0, 3, 120, 121, 122] +++       [106])+  , thereAndBackAgainTest "LIST_EXT - nested"+      (ListTerm [ListTerm [AtomTerm "abc"], ListTerm [AtomTerm "xyz"]])+      ([131, 108, 0, 0, 0, 2] +++       ([108, 0, 0, 0, 1] ++ [100, 0, 3, 97, 98, 99]    ++ [106]) +++       ([108, 0, 0, 0, 1] ++ [100, 0, 3, 120, 121, 122] ++ [106]) +++       [106])+  , thereAndBackAgainTest "BINARY_EXT"+      (BinaryTerm "x\0y\1z")+      ([131, 109, 0, 0, 0, 5, 120, 0, 121, 1, 122])+  , thereAndBackAgainTest " SMALL_BIG_EXT"+      (BigintTerm $ 4 + 3 * 256 + 2 * 256^2 + 1 * 256^3)+      ([131, 110, 4, 0, 4, 3, 2, 1])+  ]++thereAndBackAgainTest :: String -> Term -> [Word8] -> TestTree+thereAndBackAgainTest name term binaryRepr = testGroup name+  [ testCase "Term -> binary" $+      L.unpack (encode term) @?= binaryRepr+  , testCase "binary -> Term" $+      decode (L.pack binaryRepr) @?= term+  ]+