[commit: packages/bytestring] ghc-head: Add tests for the ShortByteString (5a86aa7)
git at git.haskell.org
git
Fri Oct 4 08:27:45 UTC 2013
Repository : ssh://git at git.haskell.org/bytestring
On branch : ghc-head
Link : http://git.haskell.org/packages/bytestring.git/commitdiff/5a86aa70a76c06444200253e5a9da97c1116bec1
>---------------------------------------------------------------
commit 5a86aa70a76c06444200253e5a9da97c1116bec1
Author: Duncan Coutts <duncan at community.haskell.org>
Date: Tue Sep 17 12:30:31 2013 +0100
Add tests for the ShortByteString
>---------------------------------------------------------------
5a86aa70a76c06444200253e5a9da97c1116bec1
tests/Properties.hs | 92 ++++++++++++++++++++++++
tests/builder/Data/ByteString/Builder/Tests.hs | 7 ++
2 files changed, 99 insertions(+)
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 7d8c33b..9f60552 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -41,6 +41,7 @@ import qualified Data.ByteString as P
import qualified Data.ByteString.Internal as P
import qualified Data.ByteString.Unsafe as P
import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Short as Short
import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString.Lazy.Char8 as D
@@ -1739,6 +1740,95 @@ prop_isSpaceWord8 (w :: Word8) = isSpace c == P.isSpaceChar8 c
------------------------------------------------------------------------
+-- ByteString.Short
+--
+
+prop_short_pack_unpack xs =
+ (Short.unpack . Short.pack) xs == xs
+prop_short_toShort_fromShort bs =
+ (Short.fromShort . Short.toShort) bs == bs
+
+prop_short_toShort_unpack bs =
+ (Short.unpack . Short.toShort) bs == P.unpack bs
+prop_short_pack_fromShort xs =
+ (Short.fromShort . Short.pack) xs == P.pack xs
+
+prop_short_empty =
+ Short.empty == Short.toShort P.empty
+ && Short.empty == Short.pack []
+ && Short.null (Short.toShort P.empty)
+ && Short.null (Short.pack [])
+ && Short.null Short.empty
+
+prop_short_null_toShort bs =
+ P.null bs == Short.null (Short.toShort bs)
+prop_short_null_pack xs =
+ null xs == Short.null (Short.pack xs)
+
+prop_short_length_toShort bs =
+ P.length bs == Short.length (Short.toShort bs)
+prop_short_length_pack xs =
+ length xs == Short.length (Short.pack xs)
+
+prop_short_index_pack xs =
+ all (\i -> Short.pack xs `Short.index` i == xs !! i)
+ [0 .. length xs - 1]
+prop_short_index_toShort bs =
+ all (\i -> Short.toShort bs `Short.index` i == bs `P.index` i)
+ [0 .. P.length bs - 1]
+
+prop_short_eq xs ys =
+ (xs == ys) == (Short.pack xs == Short.pack ys)
+prop_short_ord xs ys =
+ (xs `compare` ys) == (Short.pack xs `compare` Short.pack ys)
+
+prop_short_mappend_empty_empty =
+ Short.empty `mappend` Short.empty == Short.empty
+prop_short_mappend_empty xs =
+ Short.empty `mappend` Short.pack xs == Short.pack xs
+ && Short.pack xs `mappend` Short.empty == Short.pack xs
+prop_short_mappend xs ys =
+ (xs `mappend` ys) == Short.unpack (Short.pack xs `mappend` Short.pack ys)
+prop_short_mconcat xss =
+ mconcat xss == Short.unpack (mconcat (map Short.pack xss))
+
+prop_short_fromString s =
+ fromString s == Short.fromShort (fromString s)
+
+prop_short_show xs =
+ show (Short.pack xs) == show (map P.w2c xs)
+prop_short_show' xs =
+ show (Short.pack xs) == show (P.pack xs)
+
+prop_short_read xs =
+ read (show (Short.pack xs)) == Short.pack xs
+
+
+short_tests =
+ [ testProperty "pack/unpack" prop_short_pack_unpack
+ , testProperty "toShort/fromShort" prop_short_toShort_fromShort
+ , testProperty "toShort/unpack" prop_short_toShort_unpack
+ , testProperty "pack/fromShort" prop_short_pack_fromShort
+ , testProperty "empty" prop_short_empty
+ , testProperty "null/toShort" prop_short_null_toShort
+ , testProperty "null/pack" prop_short_null_pack
+ , testProperty "length/toShort" prop_short_length_toShort
+ , testProperty "length/pack" prop_short_length_pack
+ , testProperty "index/pack" prop_short_index_pack
+ , testProperty "index/toShort" prop_short_index_toShort
+ , testProperty "Eq" prop_short_eq
+ , testProperty "Ord" prop_short_ord
+ , testProperty "mappend/empty/empty" prop_short_mappend_empty_empty
+ , testProperty "mappend/empty" prop_short_mappend_empty
+ , testProperty "mappend" prop_short_mappend
+ , testProperty "mconcat" prop_short_mconcat
+ , testProperty "fromString" prop_short_fromString
+ , testProperty "show" prop_short_show
+ , testProperty "show'" prop_short_show'
+ , testProperty "read" prop_short_read
+ ]
+
+------------------------------------------------------------------------
-- The entry point
main :: IO ()
@@ -1756,6 +1846,7 @@ tests = misc_tests
++ bb_tests
++ ll_tests
++ io_tests
+ ++ short_tests
++ rules
--
@@ -2480,3 +2571,4 @@ ll_tests =
, testProperty "concatMap" prop_concatMap
, testProperty "isSpace" prop_isSpaceWord8
]
+
diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs
index 0c0fdf3..1be1826 100644
--- a/tests/builder/Data/ByteString/Builder/Tests.hs
+++ b/tests/builder/Data/ByteString/Builder/Tests.hs
@@ -28,6 +28,7 @@ import Data.Foldable (asum, foldMap)
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Short as Sh
import Data.ByteString.Builder
import Data.ByteString.Builder.Extra
@@ -188,6 +189,7 @@ data Mode =
data Action =
SBS Mode S.ByteString
| LBS Mode L.ByteString
+ | ShBS Sh.ShortByteString
| W8 Word8
| W8S [Word8]
| String String
@@ -213,6 +215,7 @@ renderRecipe (Recipe _ firstSize _ cont as) =
renderAction (SBS _ bs) = tell $ D.fromList $ S.unpack bs
renderAction (LBS Hex lbs) = tell $ foldMap hexWord8 $ L.unpack lbs
renderAction (LBS _ lbs) = tell $ renderLBS lbs
+ renderAction (ShBS sbs) = tell $ D.fromList $ Sh.unpack sbs
renderAction (W8 w) = tell $ return w
renderAction (W8S ws) = tell $ D.fromList ws
renderAction (String cs) = tell $ foldMap (D.fromList . charUtf8_list) cs
@@ -240,6 +243,7 @@ buildAction (LBS Smart lbs) = lift $ putBuilder $ lazyByteString lbs
buildAction (LBS Copy lbs) = lift $ putBuilder $ lazyByteStringCopy lbs
buildAction (LBS Insert lbs) = lift $ putBuilder $ lazyByteStringInsert lbs
buildAction (LBS (Threshold i) lbs) = lift $ putBuilder $ lazyByteStringThreshold i lbs
+buildAction (ShBS sbs) = lift $ putBuilder $ shortByteString sbs
buildAction (W8 w) = lift $ putBuilder $ word8 w
buildAction (W8S ws) = lift $ putBuilder $ BP.primMapListFixed BP.word8 ws
buildAction (String cs) = lift $ putBuilder $ stringUtf8 cs
@@ -301,6 +305,7 @@ instance Arbitrary Action where
arbitrary = oneof
[ SBS <$> arbitrary <*> arbitrary
, LBS <$> arbitrary <*> arbitrary
+ , ShBS . Sh.toShort <$> arbitrary
, W8 <$> arbitrary
, W8S <$> listOf arbitrary
-- ensure that larger character codes are also tested
@@ -320,6 +325,8 @@ instance Arbitrary Action where
shrink (LBS m lbs) =
(LBS <$> shrink m <*> pure lbs) <|>
(LBS <$> pure m <*> shrink lbs)
+ shrink (ShBS sbs) =
+ ShBS . Sh.toShort <$> shrink (Sh.fromShort sbs)
shrink (W8 w) = W8 <$> shrink w
shrink (W8S ws) = W8S <$> shrink ws
shrink (String cs) = String <$> shrink cs
More information about the ghc-commits
mailing list