Skip to content

Instantly share code, notes, and snippets.

@gelisam
Last active February 17, 2020 05:03
Show Gist options
  • Save gelisam/b51f7db259de42b28388da53982170a8 to your computer and use it in GitHub Desktop.
Save gelisam/b51f7db259de42b28388da53982170a8 to your computer and use it in GitHub Desktop.
using Haskell's QuickCheck to property-test C's qsort
-- in response to https://www.reddit.com/r/haskell/comments/duopq8/create_tests_for_other_languages_using_haskell/
-- TLDR: yes, you can test C functions from Haskell; it's a bit painful to
-- call C from Haskell, but once you do, testing is the easy part!
{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TemplateHaskell #-}
module Main where
import Data.Foldable (for_)
import Data.Traversable (for)
import Foreign.C.Types (CInt, CSize)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (FunPtr, Ptr, castPtr)
import Foreign.Storable (Storable(peek, peekElemOff, pokeElemOff, sizeOf))
import Test.QuickCheck (quickCheck)
import Test.QuickCheck.Monadic (assert, monadicIO, run)
import qualified Language.C.Inline as C
------------------------------------------------------------------------------
-- PART 1: call C from Haskell --
-- --
-- This part is long but straightforward. It looks longer than it really is --
-- because I was careful to define a lot of intermediate values, type --
-- signatures, and comments in order to make sure everything is clear. --
------------------------------------------------------------------------------
-- import qsort
C.include "<stdlib.h>"
-- define a way to transfer the Haskell comparison function to C
type Compare = Ptr () -> Ptr () -> IO CInt
foreign import ccall "wrapper"
mkCompare :: Compare -> IO (FunPtr Compare)
qsort_wrapper :: forall a. Storable a
=> [a] -> (a -> a -> Ordering) -> IO [a]
qsort_wrapper xs f = do
-- the Haskell arguments to qsort
let nitems :: Int
nitems = length xs
bytesPerItem :: Int
bytesPerItem = sizeOf (undefined :: a)
compar :: Compare
compar void_ptr1 void_ptr2 = do
let ptr1 :: Ptr a
ptr1 = castPtr void_ptr1
ptr2 :: Ptr a
ptr2 = castPtr void_ptr2
x1 <- peek ptr1
x2 <- peek ptr2
case f x1 x2 of
LT -> pure $ -1
EQ -> pure $ 0
GT -> pure $ 1
-- allocate a buffer on the C side
allocaBytes (nitems * bytesPerItem) $ \(buffer :: Ptr a) -> do
-- fill the buffer
for_ (zip [0..] xs) $ \(i, x) -> do
pokeElemOff buffer i x
-- the C arguments to qsort
let c_buffer :: Ptr ()
c_buffer = castPtr buffer
c_nitems :: CSize
c_nitems = fromIntegral nitems
c_bytesPerItem :: CSize
c_bytesPerItem = fromIntegral bytesPerItem
c_compar :: FunPtr Compare
<- mkCompare compar
-- call qsort
[C.block|
void {
qsort(
$(void* c_buffer),
$(size_t c_nitems),
$(size_t c_bytesPerItem),
$(int (*c_compar)(const void*, const void*))
);
}
|]
-- read the buffer
for (zip [0..] xs) $ \(i, _) -> do
peekElemOff buffer i
------------------------------------------------------------------------------
-- PART 2: write ordinary Haskell tests --
-- --
-- The reason we went through the trouble of writing part 1 is so we can --
-- save time during part 2! qsort_wrapper is now an ordinary Haskell --
-- function, so we can test it using ordinary Haskell testing frameworks, --
-- e.g. QuickCheck. I assume you already know why QuickCheck is awesome :) --
------------------------------------------------------------------------------
-- a property we expect to hold of qsort's output
isSorted :: Ord a
=> [a] -> Bool
isSorted xs = and $ zipWith (<=) xs (drop 1 xs)
-- we can finally write some tests!
-- |
-- >>> unitTest
-- [1,2,4,4,6,8,9]
-- [9,8,6,4,4,2,1]
unitTest :: IO ()
unitTest = do
ys <- qsort_wrapper ([4,6,1,4,2,9,8] :: [CInt]) compare
print ys
zs <- qsort_wrapper ([4,6,1,4,2,9,8] :: [CInt]) (flip compare)
print zs
-- |
-- >>> propertyTest
-- +++ OK, passed 100 tests.
propertyTest :: IO ()
propertyTest = quickCheck $ \xs -> monadicIO $ do
ys <- run $ qsort_wrapper (xs :: [CInt]) compare
assert $ isSorted ys
main :: IO ()
main = do
unitTest
propertyTest
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment