Actually work around the poison instance

(Some re-compilation check somewhere set a trap for me.)

This also replaces fromIntegral with intToIndexTy in a few places.

tests/Properties/ByteString.hs

@@ -118,13 +118,12 @@ instance Arbitrary Natural where
 
 testRdInt :: forall a. (Arbitrary a, RdInt a) => String -> TestTree
 testRdInt s = testGroup s $
-    [ testProperty "from string" $ \ prefix suffix ->
-        forAllShrink arbitrary shrink $ \value ->
+    [ testProperty "from string" $ int64OK $ \value prefix suffix ->
         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" $ forAllShrink arbitrary shrink $ \n ->
+    , testProperty "from number" $ int64OK $ \n ->
         bread @a (B.pack (show n)) === Just (n, B.empty)
     ]
 #endif
@@ -609,13 +608,13 @@ tests =
 #endif
 
   , testProperty "index" $
-    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.index x (fromIntegral n) === B.unpack x !! n
+    \(NonNegative n) x -> intToIndexTy n < B.length x ==> B.index x (intToIndexTy n) === B.unpack x !! n
   , testProperty "indexMaybe" $
-    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.indexMaybe x (fromIntegral n) === Just (B.unpack x !! n)
+    \(NonNegative n) x -> intToIndexTy n < B.length x ==> B.indexMaybe x (intToIndexTy n) === Just (B.unpack x !! n)
   , testProperty "indexMaybe Nothing" $
-    \n x -> (n :: Int) < 0 || fromIntegral n >= B.length x ==> B.indexMaybe x (fromIntegral n) === Nothing
+    \n x -> n < 0 || intToIndexTy n >= B.length x ==> B.indexMaybe x (intToIndexTy n) === Nothing
   , testProperty "!?" $
-    \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)
+    \(intToIndexTy -> n) x -> B.indexMaybe x n === x B.!? n
 
 #ifdef BYTESTRING_CHAR8
   , testProperty "isString" $

tests/QuickCheckUtils.hs

@@ -7,6 +7,7 @@ module QuickCheckUtils
   , String8(..)
   , CByteString(..)
   , Sqrt(..)
+  , int64OK
   ) where
 
 import Test.Tasty.QuickCheck
@@ -113,6 +114,8 @@ instance Arbitrary SB.ShortByteString where
 instance CoArbitrary SB.ShortByteString where
   coarbitrary s = coarbitrary (SB.unpack s)
 
+-- | This /poison instance/ exists to make accidental mis-use
+-- of the @Arbitrary Int64@ instance a bit less likely.
 instance {-# OVERLAPPING #-} Testable (Int64 -> prop) where
   property = error $ unlines [
     "Found a test taking a raw Int64 argument.",
@@ -121,5 +124,10 @@ instance {-# OVERLAPPING #-} Testable (Int64 -> prop) where
     "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."]
+    "If very few small-numbers tests is OK, use",
+    "'int64OK' to bypass this poison-instance."]
+
+-- | Use this to bypass the poison instance for @Testable (Int64 -> prop)@
+-- defined in "QuickCheckUtils".
+int64OK :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
+int64OK f = propertyForAllShrinkShow arbitrary shrink (\v -> [show v]) f

tests/builder/Data/ByteString/Builder/Tests.hs

@@ -52,9 +52,9 @@ import           System.Posix.Internals (c_unlink)
 
 import           Test.Tasty (TestTree, TestName, testGroup)
 import           Test.Tasty.QuickCheck
-                   ( Arbitrary(..), oneof, choose, listOf, elements, forAll
+                   ( Arbitrary(..), oneof, choose, listOf, elements
                    , counterexample, ioProperty, Property, testProperty
-                   , (===), (.&&.), conjoin
+                   , (===), (.&&.), conjoin, forAll, forAllShrink
                    , UnicodeString(..), NonNegative(..)
                    )
 import           QuickCheckUtils
@@ -538,7 +538,8 @@ testBuilderConstr :: (Arbitrary a, Show a)
 testBuilderConstr name ref mkBuilder =
     testProperty name check
   where
-    check x = forAll (choose (0, maxPaddingAmount)) $ \paddingAmount -> let
+    check = int64OK $ \x ->
+            forAllShrink genPaddingAmount shrink $ \paddingAmount -> let
       -- use padding to make sure we test at unaligned positions
       ws = ref x
       b1 = mkBuilder x
@@ -548,6 +549,7 @@ testBuilderConstr name ref mkBuilder =
 
     maxPaddingAmount = 15
     padBuf = S.replicate maxPaddingAmount (S.c2w ' ')
+    genPaddingAmount = choose (0, maxPaddingAmount)
 
 
 testsBinary :: [TestTree]