    {-# LANGUAGE ScopedTypeVariables #-}

    module Hedgehog.Classes.Storable (storableLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common
    import Hedgehog.Internal.Gen (sample)

    import qualified Data.List as List
    import qualified Hedgehog.Gen as Gen
    import qualified Hedgehog.Range as Range

    import Foreign.Marshal.Alloc
    import Foreign.Marshal.Array
    import GHC.Ptr (Ptr(..), nullPtr, plusPtr, minusPtr, alignPtr)
    import Foreign.Storable (Storable(..))
    import System.IO.Unsafe (unsafePerformIO)

    -- | Tests the following 'Storable' laws:
    --
    -- [__Set-Get__]: @'pokeElemOff' ptr ix a '>>' 'peekElemOff' ptr ix@ ≡ @'pure' a@
    -- [__Get-Set__]: @'peekElemOff' ptr ix '>>=' 'pokeElemOff' ptr ix@ ≡ @'pure' ()@ (Putting back what you got out has no effect)
    -- [__List Conversion Roundtrips__]: Mallocing a list and then reconstructing it gives you the same list
    -- [__PeekElemOff/Peek__]: @'peekElemOff' a i@ ≡ @'peek' ('plusPtr' a (i '*' 'sizeOf' 'undefined'))@
    -- [__PokeElemOff/Poke__]: @'pokeElemOff' a i x@ ≡ @'poke' ('plusPtr' a (i '*' 'sizeOf' 'undefined')) x@
    -- [__PeekByteOff/Peek__]: @'peekByteOff' a i@ ≡ @'peek' ('plusPtr' a i)@
    -- [__PokeByteOff/Peek__]: @'pokeByteOff' a i x@ ≡ @'poke' ('plusPtr' a i) x@
    storableLaws :: (Eq a, Show a, Storable a) => Gen a -> Laws
    storableLaws :: forall a. (Eq a, Show a, Storable a) => Gen a -> Laws
    storableLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Storable"
      [ (String
    "Set-Get (you get back what you put in)", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableSetGet Gen a
    gen)
      , (String
    "Get-Set (putting back what you got out has no effect)", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableGetSet Gen a
    gen)
      , (String
    "List Conversion Roundtrips", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableList Gen a
    gen)
      , (String
    "peekElemOff a i ≡ peek (plusPtr a (i * sizeOf undefined))", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekElem Gen a
    gen)
      , (String
    "pokeElemOff a i x ≡ poke (plusPtr a (i * sizeOf undefined)) x ≡ id ", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeElem Gen a
    gen)
      , (String
    "peekByteOff a i ≡ peek (plusPtr a i)", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekByte Gen a
    gen)
      , (String
    "pokeByteOff a i x ≡ poke (plusPtr a i) x ≡ id ", Gen a -> Property
    forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeByte Gen a
    gen)
      ]

    genArray :: forall a. (Storable a) => Gen a -> Int -> IO (Ptr a)
    genArray :: forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len = do
      let go :: Int -> [a] -> f [a]
    go Int
    ix [a]
    xs = if Int
    ix Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    len
            then [a] -> f [a]
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [a]
    xs
            else do
              a
    x <- Gen a -> f a
    forall (m :: * -> *) a. MonadIO m => Gen a -> m a
    sample Gen a
    gen
              Int -> [a] -> f [a]
    go (Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    xs)
      [a]
    as <- Int -> [a] -> IO [a]
    forall {f :: * -> *}. MonadIO f => Int -> [a] -> f [a]
    go Int
    0 []
      [a] -> IO (Ptr a)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray [a]
    as

    storablePeekElem :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekElem :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekElem Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
      Int
    ix <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    addr <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        a
    x <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    addr Int
    ix
        a
    y <- Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr a
    addr Ptr a -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` (Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)))
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    addr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    x a -> a -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === a
    y)

    storablePokeElem :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeElem :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeElem Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      a
    x <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
      Int
    ix <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    addr <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr a
    addr Int
    ix a
    x
        a
    u <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    addr Int
    ix
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr a
    addr Ptr a -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` (Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * a -> Int
    forall a. Storable a => a -> Int
    sizeOf a
    x)) a
    x
        a
    v <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    addr Int
    ix
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    addr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    u a -> a -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === a
    v)

    storablePeekByte :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekByte :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePeekByte Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
      Int
    ix <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      let off :: Int
    off = Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Ptr Any
    forall a. Ptr a
    nullPtr Ptr Any -> Int -> Ptr Any
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` a -> Int
    forall a. Storable a => a -> Int
    sizeOf ([a] -> a
    forall a. HasCallStack => [a] -> a
    head [a]
    as)) Ptr Any -> Int -> Ptr Any
    forall a. Ptr a -> Int -> Ptr a
    `alignPtr` a -> Int
    forall a. Storable a => a -> Int
    alignment ([a] -> a
    forall a. HasCallStack => [a] -> a
    head [a]
    as) Ptr Any -> Ptr Any -> Int
    forall a b. Ptr a -> Ptr b -> Int
    `minusPtr` Ptr Any
    forall a. Ptr a
    nullPtr
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    addr <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        a
    x :: a <- Ptr a -> Int -> IO a
    forall b. Ptr b -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr a
    addr Int
    off
        a
    y :: a <- Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr a
    addr Ptr a -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off)
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    addr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    x a -> a -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === a
    y)

    storablePokeByte :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeByte :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storablePokeByte Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      a
    x <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
      Int
    off <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    addr <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        Ptr a -> Int -> a -> IO ()
    forall b. Ptr b -> Int -> a -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    addr Int
    off a
    x
        a
    u :: a <- Ptr a -> Int -> IO a
    forall b. Ptr b -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr a
    addr Int
    off
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr a
    addr Ptr a -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) a
    x
        a
    v :: a <- Ptr a -> Int -> IO a
    forall b. Ptr b -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr a
    addr Int
    off
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    addr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    u a -> a -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === a
    v)

    storableSetGet :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableSetGet :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableSetGet Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a
    a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      Int
    len <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    1 Int
    20)
      Int
    ix <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    ptr <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr a
    ptr Int
    ix a
    a
        a
    a' <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptr Int
    ix
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    ptr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    a a -> a -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === a
    a')

    storableGetSet :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableGetSet :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableGetSet Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
      Int
    ix <- Gen Int -> PropertyT IO Int
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
    forall a b. (a -> b) -> a -> b
    $ Range Int -> Gen Int
    forall (m :: * -> *). MonadGen m => Range Int -> m Int
    Gen.int (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Ptr a
    ptrA <- [a] -> IO (Ptr a)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray [a]
    as
        Ptr a
    ptrB <- Gen a -> Int -> IO (Ptr a)
    forall a. Storable a => Gen a -> Int -> IO (Ptr a)
    genArray Gen a
    gen Int
    len
        Ptr a -> Ptr a -> Int -> IO ()
    forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
    copyArray Ptr a
    ptrB Ptr a
    ptrA Int
    len
        a
    a <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptrA Int
    ix
        Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr a
    ptrA Int
    ix a
    a
        Bool
    res <- Ptr a -> Ptr a -> Int -> IO Bool
    forall a. (Eq a, Storable a) => Ptr a -> Ptr a -> Int -> IO Bool
    arrayEq Ptr a
    ptrA Ptr a
    ptrB Int
    len
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    ptrA
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    ptrB
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    res Bool -> Bool -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === Bool
    True)

    storableList :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableList :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property
    storableList Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      [a]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen
      IO (PropertyT IO ()) -> PropertyT IO ()
    forall a. IO a -> a
    unsafePerformIO (IO (PropertyT IO ()) -> PropertyT IO ())
    -> IO (PropertyT IO ()) -> PropertyT IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let len :: Int
    len = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    List.length [a]
    as
        Ptr a
    ptr <- [a] -> IO (Ptr a)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray [a]
    as
        let rebuild :: Int -> IO [a]
            rebuild :: Int -> IO [a]
    rebuild Int
    ix = if Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len
              then (:) (a -> [a] -> [a]) -> IO a -> IO ([a] -> [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptr Int
    ix IO ([a] -> [a]) -> IO [a] -> IO [a]
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> IO [a]
    rebuild (Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
              else [a] -> IO [a]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
        [a]
    asNew <- Int -> IO [a]
    rebuild Int
    0
        Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    ptr
        PropertyT IO () -> IO (PropertyT IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([a]
    as [a] -> [a] -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, Eq a, Show a, HasCallStack) =>
    a -> a -> m ()
    === [a]
    asNew)

    arrayEq :: forall a. (Eq a, Storable a) => Ptr a -> Ptr a -> Int -> IO Bool
    arrayEq :: forall a. (Eq a, Storable a) => Ptr a -> Ptr a -> Int -> IO Bool
    arrayEq Ptr a
    ptrA Ptr a
    ptrB Int
    len = Int -> IO Bool
    go Int
    0 where
      go :: Int -> IO Bool
    go Int
    i = if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    len
        then do
          a
    a <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptrA Int
    i
          a
    b <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptrB Int
    i
          if a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    b
            then Int -> IO Bool
    go (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            else Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        else Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True