Ptr.hs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE TypeOperators            #-}

module Test.IO.Ptr (

  test_ptr,

) where

import Config

import Prelude                                  as P
import Foreign.C
import Foreign.Ptr
import Test.Framework
import Test.HUnit                               ( Assertion, (@?=) )
import Test.Framework.Providers.HUnit

import Data.Array.Accelerate
import Data.Array.Accelerate.IO


test_ptr :: Config -> Test
test_ptr _ =
  testGroup "block copy"
    [
      testCase "toPtr Int16"            toPtrInt16
    , testCase "toPtr Int32"            toPtrInt32
    , testCase "toPtr Int64"            toPtrInt64
    , testCase "fromPtr Int32"          fromPtrInt32
    , testCase "fromPtr (Int32,Double)" fromPtrIntDouble
    , testCase "fromArray Int32"        fromArrayInt32
    ]


-- Unit tests ------------------------------------------------------------------
--
intToBool :: P.Integral a => a -> Bool
intToBool 0 = False
intToBool _ = True

fromPtrInt32 :: Assertion
fromPtrInt32 = do
  ptr   <- oneToTen
  arr   <- fromPtr (Z :. 10) ptr        :: IO (Vector Int32)
  toList arr @?= [1..10]

fromPtrIntDouble :: Assertion
fromPtrIntDouble = do
  intPtr        <- oneToTen
  doublePtr     <- tenToOne
  arr           <- fromPtr (Z :. 10) (((), intPtr), doublePtr)    :: IO (Vector (Int32, Double))
  toList arr @?= [ (x, P.fromIntegral (11 - x)) | x <- [1..10]]


toPtrInt16 :: IO ()
toPtrInt16 = do
  let n = 50
      arr :: Vector Int16
      arr = fromList (Z:.n) [2 * P.fromIntegral x | x <- [0..n-1]]
  --
  ohi <- nInt16s (P.fromIntegral n)
  toPtr arr ohi
  b   <- isFilledWithEvens16 ohi (P.fromIntegral n)
  intToBool b @?= True

toPtrInt32 :: IO ()
toPtrInt32 = do
  let n = 100
      arr :: Array DIM2 Int32
      arr = fromList (Z:.10:.10) [2 * P.fromIntegral x | x <- [0..n-1]]
  --
  ohi <- nInt32s n
  toPtr arr ohi
  b   <- isFilledWithEvens32 ohi n
  intToBool b @?= True

toPtrInt64 :: IO ()
toPtrInt64 = do
  let n = 73
      arr :: Vector Int64
      arr = fromList (Z:.n) [2 * P.fromIntegral x | x <- [0..n-1]]
  --
  ohi <- nInt64s (P.fromIntegral n)
  toPtr arr ohi
  b   <- isFilledWithEvens64 ohi (P.fromIntegral n)
  intToBool b @?= True


fromArrayInt32 :: IO ()
fromArrayInt32 = do
  let n = 5 P.^ (3::Int)
      arr :: Array DIM3 Int32
      arr = fromList (Z:.5:.5:.5) [2*x | x <- [0..n-1]]
  --
  ohi <- nInt32s (P.fromIntegral n)
  fromArray arr (memcpy ohi)
  b   <- isFilledWithEvens32 ohi (P.fromIntegral n)
  intToBool b @?= True


-- Foreign functions -----------------------------------------------------------
--
foreign import ccall "one_to_ten" oneToTen :: IO (Ptr Int32)
foreign import ccall "ten_to_one" tenToOne :: IO (Ptr Double)
foreign import ccall "n_int_16s" nInt16s :: CInt -> IO (Ptr Int16)
foreign import ccall "n_int_32s" nInt32s :: CInt -> IO (Ptr Int32)
foreign import ccall "n_int_64s" nInt64s :: CInt -> IO (Ptr Int64)
foreign import ccall "is_filled_with_evens_16" isFilledWithEvens16 :: Ptr Int16 -> CInt -> IO CInt
foreign import ccall "is_filled_with_evens_32" isFilledWithEvens32 :: Ptr Int32 -> CInt -> IO CInt
foreign import ccall "is_filled_with_evens_64" isFilledWithEvens64 :: Ptr Int64 -> CInt -> IO CInt
foreign import ccall memcpy :: Ptr a -> Ptr b -> Int -> IO ()