diff --git a/AtomicPrimops/testing/TemplateHaskellSplices.hs b/AtomicPrimops/testing/TemplateHaskellSplices.hs new file mode 100644 index 0000000..b69c8bc --- /dev/null +++ b/AtomicPrimops/testing/TemplateHaskellSplices.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell, + RankNTypes #-} + +-- | TH splices used in atommic-primops tests. +-- Splices defined in own module for technical reasons. + +module TemplateHaskellSplices where + +import Language.Haskell.TH +import Control.Monad (replicateM) + +tmap :: forall a. (Enum a, Eq a, Num a) + => a -> Int -> Q Exp +tmap i n = do + f <- newName "f" + as <- replicateM n (newName "a") + lamE [varP f, tupP (map varP as)] $ + tupE [ if i == i' + then [| $(varE f) $a |] + else a + | (a,i') <- map varE as `zip` [1..] ] diff --git a/AtomicPrimops/testing/ghci-test.hs b/AtomicPrimops/testing/ghci-test.hs new file mode 100644 index 0000000..e8c021c --- /dev/null +++ b/AtomicPrimops/testing/ghci-test.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | Test the invocation of the GHCi bytecode intepreter with atomic-primops. + +module Main where + +import Data.Atomics -- import needed to test whether ghci linking error occurs +import TemplateHaskellSplices (tmap) +import Test.Framework (defaultMain) +import Test.Framework.Providers.HUnit (testCase) + +main :: IO () +main = defaultMain + [ + ---------------------------------------- + testCase "Template_Haskell_invocation" $ do + putStrLn "Attempting Template Haskell implementation of map operation" + print $ $(tmap 3 4) (+ 1) (1,2,3,4) -- comment out for compilation to succeed + ---------------------------------------- + ] diff --git a/AtomicPrimops/testing/test-atomic-primops.cabal b/AtomicPrimops/testing/test-atomic-primops.cabal index 4932883..09966d7 100644 --- a/AtomicPrimops/testing/test-atomic-primops.cabal +++ b/AtomicPrimops/testing/test-atomic-primops.cabal @@ -14,6 +14,10 @@ Flag threaded Description: Enable GHC threaded RTS. Default: True +Flag withTH + Description: Build the test suite, including the template-haskell-atomic-primops executable. + Default: False + Test-Suite test-atomic-primops type: exitcode-stdio-1.0 main-is: Test.hs @@ -35,3 +39,13 @@ Test-Suite test-atomic-primops Executable hello-world-atomic-primops main-is: hello.hs build-depends: base >= 4.5, atomic-primops + +Executable template-haskell-atomic-primops + main-is: ghci-test.hs + if flag(withTH) + Buildable: True + else + Buildable: False + build-depends: base >= 4.5, atomic-primops >= 0.4, template-haskell, + -- For Testing: + test-framework, test-framework-hunit