diff --git a/Data/Text.hs b/Data/Text.hs --- a/Data/Text.hs +++ b/Data/Text.hs @@ -199,7 +199,7 @@ (&&), (||), (+), (-), (.), ($), ($!), (>>), not, return, otherwise, quot) #if defined(HAVE_DEEPSEQ) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(rnf)) #endif #if defined(ASSERTS) import Control.Exception (assert) @@ -346,7 +346,7 @@ #endif #if defined(HAVE_DEEPSEQ) -instance NFData Text +instance NFData Text where rnf !_ = () #endif -- | This instance preserves data abstraction at the cost of inefficiency. @@ -666,11 +666,33 @@ reverse t = S.reverse (stream t) {-# INLINE reverse #-} --- | /O(m+n)/ Replace every occurrence of one substring with another. +-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in +-- @haystack@ with @replacement@. -- +-- This function behaves as though it was defined as follows: +-- +-- @ +-- replace needle replacement haystack = +-- 'intercalate' replacement ('splitOn' needle haystack) +-- @ +-- +-- As this suggests, each occurrence is replaced exactly once. So if +-- @needle@ occurs in @replacement@, that occurrence will /not/ itself +-- be replaced recursively: +-- +-- > replace "oo" "foo" "oo" == "foo" +-- +-- In cases where several instances of @needle@ overlap, only the +-- first one will be replaced: +-- +-- > replace "ofo" "bar" "ofofo" == "barfo" +-- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -replace :: Text -> Text -> Text -> Text +replace :: Text -- ^ @needle@ to search for + -> Text -- ^ @replacement@ to replace @needle@ with + -> Text -- ^ @haystack@ in which to search + -> Text replace needle@(Text _ _ neeLen) (Text repArr repOff repLen) haystack@(Text hayArr hayOff hayLen) diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs --- a/Data/Text/Lazy.hs +++ b/Data/Text/Lazy.hs @@ -663,7 +663,26 @@ where rev a Empty = a rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts --- | /O(m+n)/ Replace every occurrence of one substring with another. +-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in +-- @haystack@ with @replacement@. +-- +-- This function behaves as though it was defined as follows: +-- +-- @ +-- replace needle replacement haystack = +-- 'intercalate' replacement ('splitOn' needle haystack) +-- @ +-- +-- As this suggests, each occurrence is replaced exactly once. So if +-- @needle@ occurs in @replacement@, that occurrence will /not/ itself +-- be replaced recursively: +-- +-- > replace "oo" "foo" "oo" == "foo" +-- +-- In cases where several instances of @needle@ overlap, only the +-- first one will be replaced: +-- +-- > replace "ofo" "bar" "ofofo" == "barfo" -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. diff --git a/Data/Text/Lazy/Builder/Int.hs b/Data/Text/Lazy/Builder/Int.hs --- a/Data/Text/Lazy/Builder/Int.hs +++ b/Data/Text/Lazy/Builder/Int.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables, + UnboxedTuples #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif @@ -133,8 +134,15 @@ countDigits :: (Integral a) => a -> Int {-# INLINE countDigits #-} -countDigits v0 = go 1 (fromIntegral v0 :: Word64) - where go !k v +countDigits v0 + | fromIntegral v64 == v0 = go 1 v64 + | otherwise = goBig 1 (fromIntegral v0) + where v64 = fromIntegral v0 + goBig !k (v :: Integer) + | v > big = goBig (k + 19) (v `quot` big) + | otherwise = go k (fromIntegral v) + big = 10000000000000000000 + go !k (v :: Word64) | v < 10 = k | v < 100 = k + 1 | v < 1000 = k + 2 @@ -186,10 +194,6 @@ | otherwise = singleton $! toEnum (fromIntegral n + 87) {-# INLINE hexDigit #-} -int :: Int -> Builder -int = decimal -{-# INLINE int #-} - data T = T !Integer !Int integer :: Int -> Integer -> Builder @@ -247,6 +251,10 @@ where q = fromInteger x r = fromInteger y putB _ = mempty + + int :: Int -> Builder + int x | base == 10 = decimal x + | otherwise = hexadecimal x pblock = loop maxDigits where diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +1.2.0.2 + +* Bumped lower bound on deepseq to 1.4 for compatibility with the + upcoming GHC 7.10 + +1.2.0.1 + +* Fixed a buffer overflow in rendering of large Integers + (https://github.com/bos/text/issues/99) + 1.2.0.0 * Fixed an integer overflow in the replace function diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -741,6 +741,7 @@ tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show) tb_decimal_integer (a::Integer) = tb_decimal a +tb_decimal_integer_big (Big a) = tb_decimal a tb_decimal_int (a::Int) = tb_decimal a tb_decimal_int8 (a::Int8) = tb_decimal a tb_decimal_int16 (a::Int16) = tb_decimal a @@ -752,6 +753,11 @@ tb_decimal_word32 (a::Word32) = tb_decimal a tb_decimal_word64 (a::Word64) = tb_decimal a +tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a +tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a +tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a +tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a + tb_hex :: (Integral a, Show a) => a -> Bool tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "") @@ -1252,11 +1258,16 @@ testProperty "tb_decimal_int32" tb_decimal_int32, testProperty "tb_decimal_int64" tb_decimal_int64, testProperty "tb_decimal_integer" tb_decimal_integer, + testProperty "tb_decimal_integer_big" tb_decimal_integer_big, testProperty "tb_decimal_word" tb_decimal_word, testProperty "tb_decimal_word8" tb_decimal_word8, testProperty "tb_decimal_word16" tb_decimal_word16, testProperty "tb_decimal_word32" tb_decimal_word32, - testProperty "tb_decimal_word64" tb_decimal_word64 + testProperty "tb_decimal_word64" tb_decimal_word64, + testProperty "tb_decimal_big_int" tb_decimal_big_int, + testProperty "tb_decimal_big_word" tb_decimal_big_word, + testProperty "tb_decimal_big_int64" tb_decimal_big_int64, + testProperty "tb_decimal_big_word64" tb_decimal_big_word64 ], testGroup "hexadecimal" [ testProperty "tb_hexadecimal_int" tb_hexadecimal_int, diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -7,17 +7,11 @@ module Tests.QuickCheckUtils ( genUnicode - , genUnicodeWith - , ascii - , plane0 - , plane1 - , plane2 - , plane14 - , planes - , unsquare , smallArbitrary + , BigBounded(..) + , BigInt(..) , NotEmpty (..) , Small (..) @@ -37,11 +31,10 @@ , write_read ) where +import Control.Applicative ((<$>)) import Control.Arrow (first, (***)) import Control.DeepSeq (NFData (..), deepseq) import Control.Exception (bracket) -import Data.Bits ((.&.)) -import Data.Char (chr) import Data.String (IsString, fromString) import Data.Text.Foreign (I16) import Data.Word (Word8, Word16) @@ -49,6 +42,7 @@ import System.Random (Random (..), RandomGen) import Test.QuickCheck hiding (Small (..), (.&.)) import Test.QuickCheck.Monadic (assert, monadicIO, run) +import Test.QuickCheck.Unicode (string) import Tests.Utils import qualified Data.ByteString as B import qualified Data.Text as T @@ -60,6 +54,14 @@ import qualified Data.Text.Lazy as TL import qualified System.IO as IO +#if !MIN_VERSION_base(4,4,0) +import Data.Int (Int64) +import Data.Word (Word, Word64) +#endif + +genUnicode :: IsString a => Gen a +genUnicode = fromString <$> string + instance Random I16 where randomR = integralRandomR random = randomR (minBound,maxBound) @@ -73,75 +75,22 @@ shrink = map B.pack . shrink . B.unpack #if !MIN_VERSION_base(4,4,0) -instance Random Word8 where +instance Random Int64 where randomR = integralRandomR random = randomR (minBound,maxBound) -#endif -genUnicode :: IsString a => Gen a -genUnicode = genUnicodeWith planes - -genUnicodeWith :: IsString a => [Gen Int] -> Gen a -genUnicodeWith gens = fmap fromString string - where - string = sized $ \n -> - do k <- choose (0,n) - sequence [ char | _ <- [1..k] ] - - excluding :: [a -> Bool] -> Gen a -> Gen a - excluding bad gen = loop - where - loop = do - x <- gen - if or (map ($ x) bad) - then loop - else return x - - reserved = [lowSurrogate, highSurrogate, noncharacter] - lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF - highSurrogate c = c >= 0xD800 && c <= 0xDBFF - noncharacter c = masked == 0xFFFE || masked == 0xFFFF - where - masked = c .&. 0xFFFF - - char = chr `fmap` excluding reserved (oneof gens) - -ascii :: Gen Int -ascii = choose (0,0x7F) - -plane0 :: Gen Int -plane0 = choose (0xF0, 0xFFFF) - -plane1 :: Gen Int -plane1 = oneof [ choose (0x10000, 0x10FFF) - , choose (0x11000, 0x11FFF) - , choose (0x12000, 0x12FFF) - , choose (0x13000, 0x13FFF) - , choose (0x1D000, 0x1DFFF) - , choose (0x1F000, 0x1FFFF) - ] - -plane2 :: Gen Int -plane2 = oneof [ choose (0x20000, 0x20FFF) - , choose (0x21000, 0x21FFF) - , choose (0x22000, 0x22FFF) - , choose (0x23000, 0x23FFF) - , choose (0x24000, 0x24FFF) - , choose (0x25000, 0x25FFF) - , choose (0x26000, 0x26FFF) - , choose (0x27000, 0x27FFF) - , choose (0x28000, 0x28FFF) - , choose (0x29000, 0x29FFF) - , choose (0x2A000, 0x2AFFF) - , choose (0x2B000, 0x2BFFF) - , choose (0x2F000, 0x2FFFF) - ] +instance Random Word where + randomR = integralRandomR + random = randomR (minBound,maxBound) -plane14 :: Gen Int -plane14 = choose (0xE0000, 0xE0FFF) +instance Random Word8 where + randomR = integralRandomR + random = randomR (minBound,maxBound) -planes :: [Gen Int] -planes = [ascii, plane0, plane1, plane2, plane14] +instance Random Word64 where + randomR = integralRandomR + random = randomR (minBound,maxBound) +#endif -- For tests that have O(n^2) running times or input sizes, resize -- their inputs to the square root of the originals. @@ -159,6 +108,20 @@ instance Arbitrary TL.Text where arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary shrink = map TL.pack . shrink . TL.unpack + +newtype BigInt = Big Integer + deriving (Eq, Show) + +instance Arbitrary BigInt where + arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) + shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l] + where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer + +newtype BigBounded a = BigBounded a + deriving (Eq, Show) + +instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where + arbitrary = BigBounded <$> choose (minBound, maxBound) newtype NotEmpty a = NotEmpty { notEmpty :: a } deriving (Eq, Ord) diff --git a/tests/text-tests.cabal b/tests/text-tests.cabal --- a/tests/text-tests.cabal +++ b/tests/text-tests.cabal @@ -51,6 +51,7 @@ bytestring, deepseq, directory, + quickcheck-unicode, random, test-framework >= 0.4, test-framework-hunit >= 0.2, diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,5 +1,5 @@ name: text -version: 1.2.0.0 +version: 1.2.0.2 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type. @@ -169,6 +169,7 @@ deepseq, directory, ghc-prim, + quickcheck-unicode, random, test-framework >= 0.4, test-framework-hunit >= 0.2,