packages feed

llvm-extra-0.13.1: test/Test/RunNice.hs

module Test.RunNice where

import qualified Test.QuickCheck as QC

import Test.Run (generateFunction, derefTestCasePtr, modul)

import qualified LLVM.Extra.Nice.Value.Marshal as Marshal
import qualified LLVM.Extra.Nice.Value as NV
import qualified LLVM.Core as LLVM

import System.IO.Unsafe (unsafePerformIO)


sharedRun ::
   (QC.Testable prop, Marshal.C a, Marshal.C b) =>
   (NV.T a -> LLVM.CodeGenFunction () (NV.T b)) ->
   ((a -> b) -> prop) -> QC.Property
sharedRun f prop =
   QC.idempotentIOProperty $ do
      code <- runIO f
      return $ QC.forAllBlind (return code) prop

run ::
   (Marshal.C a, Marshal.C b) =>
   (NV.T a -> LLVM.CodeGenFunction () (NV.T b)) ->
   a -> b
run = unsafePerformIO . runIO

runIO ::
   (Marshal.C a, Marshal.C b) =>
   (NV.T a -> LLVM.CodeGenFunction () (NV.T b)) ->
   IO (a -> b)
runIO f = do
   funIO <- generateFunction derefTestCasePtr $ modul f

   return $ \a ->
      unsafePerformIO $
      Marshal.alloca $ \bPtr ->
      Marshal.with a $ \aPtr ->
      funIO aPtr bPtr >> Marshal.peek bPtr