diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index 58fde6b83..5bfe9df73 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -830,10 +830,10 @@ splitAtEndFold step end len bs0 = assert (len > 0) $ case bs0 of -> end (Chunk nextOutput bsL) | undershootW <- fromIntegral @Int64 @Int undershoot -- conversion Int64->Int is OK because 0 < undershoot < noLen - , amountOutput <- noLen - undershootW - , output <- S.BS noFp amountOutput - , finalSuffix <- S.BS (noFp `S.plusForeignPtr` amountOutput) undershootW - -> step output $ end (Chunk finalSuffix Empty) + , splitIndex <- noLen - undershootW + , beforeSplit <- S.BS noFp splitIndex + , afterSplit <- S.BS (noFp `S.plusForeignPtr` splitIndex) undershootW + -> step beforeSplit $ end (Chunk afterSplit bsL) Chunk (S.BS _ cLen) newBsR | cLen64 <- intToInt64 cLen diff --git a/tests/Properties/ByteString.hs b/tests/Properties/ByteString.hs index ef3bbc77b..4da7fd0c7 100644 --- a/tests/Properties/ByteString.hs +++ b/tests/Properties/ByteString.hs @@ -80,6 +80,10 @@ import Test.Tasty import Test.Tasty.QuickCheck import QuickCheckUtils +#ifdef BYTESTRING_LAZY +import Data.Int +#endif + #ifndef BYTESTRING_CHAR8 toElem :: Word8 -> Word8 toElem = id @@ -114,16 +118,26 @@ instance Arbitrary Natural where testRdInt :: forall a. (Arbitrary a, RdInt a) => String -> TestTree testRdInt s = testGroup s $ - [ testProperty "from string" $ \ prefix value suffix -> + [ testProperty "from string" $ \ prefix suffix -> + forAllShrink arbitrary shrink $ \value -> let si = show @a value b = prefix <> B.pack si <> suffix in fmap (second B.unpack) (bread @a b) === sread @a (B.unpack prefix ++ si ++ B.unpack suffix) - , testProperty "from number" $ \n -> + , testProperty "from number" $ forAllShrink arbitrary shrink $ \n -> bread @a (B.pack (show n)) === Just (n, B.empty) ] #endif +intToIndexTy :: Int -> IndexTy +#ifdef BYTESTRING_LAZY +type IndexTy = Int64 +intToIndexTy = fromIntegral @Int @Int64 +#else +type IndexTy = Int +intToIndexTy = id +#endif + tests :: [TestTree] tests = [ testProperty "pack . unpack" $ @@ -308,7 +322,7 @@ tests = #endif , testProperty "drop" $ - \n x -> B.unpack (B.drop n x) === List.genericDrop n (B.unpack x) + \(intToIndexTy -> n) x -> B.unpack (B.drop n x) === List.genericDrop n (B.unpack x) , testProperty "drop 10" $ \x -> let n = 10 in B.unpack (B.drop n x) === List.genericDrop n (B.unpack x) , testProperty "drop 2^31" $ @@ -325,7 +339,7 @@ tests = #endif , testProperty "take" $ - \n x -> B.unpack (B.take n x) === List.genericTake n (B.unpack x) + \(intToIndexTy -> n) x -> B.unpack (B.take n x) === List.genericTake n (B.unpack x) , testProperty "take 10" $ \x -> let n = 10 in B.unpack (B.take n x) === List.genericTake n (B.unpack x) , testProperty "take 2^31" $ @@ -342,11 +356,11 @@ tests = #endif , testProperty "dropEnd" $ - \n x -> B.dropEnd n x === B.take (B.length x - n) x + \(intToIndexTy -> n) x -> B.dropEnd n x === B.take (B.length x - n) x , testProperty "dropWhileEnd" $ \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x)) , testProperty "takeEnd" $ - \n x -> B.takeEnd n x === B.drop (B.length x - n) x + \(intToIndexTy -> n) x -> B.takeEnd n x === B.drop (B.length x - n) x , testProperty "takeWhileEnd" $ \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x)) @@ -366,7 +380,7 @@ tests = , testProperty "compareLength 4" $ \x (toElem -> c) -> B.compareLength (B.snoc x c <> undefined) (B.length x) === GT , testProperty "compareLength 5" $ - \x n -> B.compareLength x n === compare (B.length x) n + \x (intToIndexTy -> n) -> B.compareLength x n === compare (B.length x) n , testProperty "dropEnd lazy" $ \(toElem -> c) -> B.take 1 (B.dropEnd 1 (B.singleton c <> B.singleton c <> B.singleton c <> undefined)) === B.singleton c , testProperty "dropWhileEnd lazy" $ @@ -470,7 +484,8 @@ tests = (l1 == l2 || l1 == l2 + 1) && sum (map B.length splits) + l2 == B.length x , testProperty "splitAt" $ - \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x) + \(intToIndexTy -> n) x -> (B.unpack *** B.unpack) (B.splitAt n x) + === List.genericSplitAt n (B.unpack x) , testProperty "splitAt 10" $ \x -> let n = 10 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x) , testProperty "splitAt (2^31)" $ diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs index db885c672..856778bb5 100644 --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -112,3 +112,14 @@ instance Arbitrary SB.ShortByteString where instance CoArbitrary SB.ShortByteString where coarbitrary s = coarbitrary (SB.unpack s) + +instance {-# OVERLAPPING #-} Testable (Int64 -> prop) where + property = error $ unlines [ + "Found a test taking a raw Int64 argument.", + "'instance Arbitrary Int64' by default is likely to", + "produce very large numbers after the first few tests,", + "which doesn't make great indices into a LazyByteString.", + "For indices, try 'intToIndexTy' in Properties/ByteString.hs.", + "", + "If very few small-numbers tests is OK,", + "use 'forAllShrink' to bypass this poison instance."]