From: Ramakrishnan Muthukrishnan Date: Sun, 23 Jul 2017 16:36:30 +0000 (+0530) Subject: DONOTUSE quickcheck tests do not terminate X-Git-Url: https://git.rkrishnan.org/pf/content/en/service/...?a=commitdiff_plain;h=8dcb9c0c7d752fc9b6a76142064741c822d9d3a5;p=functorrent.git DONOTUSE quickcheck tests do not terminate --- diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index f359465..fd521dc 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -33,6 +33,7 @@ import Prelude hiding (length, concat) import Data.ByteString (ByteString, length, concat) import Data.ByteString.Char8 (unpack, pack) +import Data.Char (isLetter, isNumber, isPrint, isAscii) import Data.Map.Strict (Map, fromList, toList) import Text.ParserCombinators.Parsec import qualified Text.Parsec.ByteString as ParsecBS @@ -44,6 +45,11 @@ data BVal = Bint Integer | Bdict (Map String BVal) deriving (Ord, Eq, Show) +genNonEmptyString :: Gen String +genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") && + (all isAscii s) && + (all isLetter s))) + instance Arbitrary ByteString where arbitrary = pack <$> arbitrary @@ -56,7 +62,7 @@ instance Arbitrary BVal where bval n = oneof [ Bint <$> arbitrary , Bstr <$> arbitrary , Blist <$> vectorOf n (bval (n `div` 4)) - , do keys <- vectorOf n arbitrary + , do keys <- vectorOf n genNonEmptyString vals <- vectorOf n (bval (n `div` 4)) return $ Bdict $ fromList $ zip keys vals ] @@ -152,9 +158,14 @@ bencList = between (char 'l') (char 'e') (many bencVal) -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")]) bencDict :: ParsecBS.Parser (Map String BVal) bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair - where kvpair = do k <- bencStr + where kvpair = do k <- bdictKey v <- bencVal - return (unpack k, v) + return (k, v) + bdictKey = do + ds <- many1 digit <* char ':' + s <- count (read ds) alphaNum + return s + bencVal :: ParsecBS.Parser BVal bencVal = Bstr <$> bencStr <|> @@ -195,4 +206,4 @@ encode (Bdict d) = concat ["d", concat kvlist, "e"] where kvlist :: [ByteString] kvlist = [encPair kv | kv <- toList d] - encPair (k, v) = concat [encode . Bstr . pack $ k, encode v] + encPair (k, v) = concat [encode (Bstr (pack k)), encode v] diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 898cc54..13e7979 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -17,6 +17,7 @@ - along with FuncTorrent; if not, see -} +{-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Metainfo (Info(..), Metainfo(..), diff --git a/src/FuncTorrent/Tracker/Types.hs b/src/FuncTorrent/Tracker/Types.hs index 1c47d31..56d5604 100644 --- a/src/FuncTorrent/Tracker/Types.hs +++ b/src/FuncTorrent/Tracker/Types.hs @@ -28,7 +28,7 @@ module FuncTorrent.Tracker.Types , TrackerMsg(..) ) where -import Data.ByteString (ByteString) + import Data.Word (Word32) import Control.Concurrent.MVar (MVar) diff --git a/test/BencodeTests.hs b/test/BencodeTests.hs index d889643..8e54e93 100644 --- a/test/BencodeTests.hs +++ b/test/BencodeTests.hs @@ -24,9 +24,13 @@ tests = hspec $ do let encoded = encode (Bint i) decoded = decode encoded in Right (Bint i) == decoded - -- describe "Bencode property tests" $ do - -- it "encode/decode" $ do - -- property $ \bval -> - -- let encoded = encode bval - -- decoded = decode encoded - -- in Right bval == decoded + it "encode/decode blist tests" $ do + property $ \bval -> + let encoded = encode (Blist (take 1 bval)) + decoded = decode encoded + in Right (Blist (take 1 bval)) == decoded + -- it "encode/decode" $ do + -- property $ \bval -> + -- let encoded = encode bval + -- decoded = decode encoded + -- in Right bval == decoded