Memory.hs

module Test.Memory
  ( tests
  , countingHooks
  ) where

import Data.Bitmap.Roaring.FFI.Bitmap qualified as Bitmap
import Data.Bitmap.Roaring.FFI.Memory (Hooks (..))
import Data.Bitmap.Roaring.FFI.Memory qualified as Memory
import Foreign.C.Types (CSize (..))
import Foreign.Marshal.Array (withArrayLen)
import Foreign.Ptr (FunPtr, castPtrToFunPtr, nullPtr, plusPtr)
import Foreign.Storable (peek, poke)
import Hedgehog (Property, assert, evalIO, (===))
import Test.Property (returns)
import Test.Property qualified as Property
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testProperty)

foreign import ccall "&counting_malloc"
  countingMalloc :: FunPtr Memory.Malloc

foreign import ccall "&counting_realloc"
  countingRealloc :: FunPtr Memory.Realloc

foreign import ccall "&counting_calloc"
  countingCalloc :: FunPtr Memory.Calloc

foreign import ccall "&counting_aligned_malloc"
  countingAlignedMalloc :: FunPtr Memory.AlignedMalloc

foreign import ccall "stdlib.h &free"
  libcFree :: FunPtr Memory.Free

foreign import ccall unsafe "counting_allocations"
  allocations :: IO CSize

countingHooks :: Hooks
countingHooks =
  Hooks
    { malloc = countingMalloc
    , realloc = countingRealloc
    , calloc = countingCalloc
    , free = libcFree
    , alignedMalloc = countingAlignedMalloc
    , alignedFree = libcFree
    }

tests :: TestTree
tests =
  testGroup
    "Memory"
    [ testProperty "hooks poke and peek agree" hooksStorable
    , testProperty "allocations go through the installed hooks" counted
    ]

hooksStorable :: Property
hooksStorable =
  Property.example $ do
    let
      pointer offset = castPtrToFunPtr $ nullPtr `plusPtr` offset
      hooks = Hooks (pointer 16) (pointer 32) (pointer 48) (pointer 64) (pointer 80) (pointer 96)
    ptr <- Property.array 1
    evalIO $ poke ptr hooks
    peek ptr `returns` hooks

counted :: Property
counted =
  Property.example $ do
    before <- evalIO allocations
    total <- evalIO . Bitmap.with (withArrayLen [0, 2 .. 200000] $ \count values -> Bitmap.ofPtr (fromIntegral count) values) $ Bitmap.getCardinality
    total === 100001
    after <- evalIO allocations
    assert $ after > before