From 93c0e2c9bf54ec0b79f362b3146b470bbf6c76be Mon Sep 17 00:00:00 2001
From: Rob Stewart <robstewart57@gmail.com>
Date: Fri, 19 Jul 2013 18:14:01 +0100
Subject: [PATCH] Adds a currently failing (not compiling) test case. Using
 GHCi via TemplateHaskell bytecode interpretation with Data.Atomics. Related
 to rrnewton/haskell-lockfree-queue#10 . Note:  hello-word-atomic-primops.hs
 missing.

---
 .../testing/TemplateHaskellSplices.hs         | 21 +++++++++++++++++++
 AtomicPrimops/testing/ghci-test.hs            | 20 ++++++++++++++++++
 .../testing/test-atomic-primops.cabal         | 14 +++++++++++++
 3 files changed, 55 insertions(+)
 create mode 100644 AtomicPrimops/testing/TemplateHaskellSplices.hs
 create mode 100644 AtomicPrimops/testing/ghci-test.hs

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