[commit: ghc] master: Add a comprehensive test for using Annotations from TH (5f5e326)

git at git.haskell.org git at git.haskell.org
Mon Apr 28 12:46:58 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5f5e326c3c310c4bceb2b0bce291d3a0a3fc30d6/ghc

>---------------------------------------------------------------

commit 5f5e326c3c310c4bceb2b0bce291d3a0a3fc30d6
Author: Gergely Risko <errge at nilcons.com>
Date:   Fri Apr 25 15:39:26 2014 +0200

    Add a comprehensive test for using Annotations from TH
    
    The provided tests test both annotation generation and reification
    from Template Haskell.  Both --make and compilation via separate
    units (ghc -c) are tested.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

5f5e326c3c310c4bceb2b0bce291d3a0a3fc30d6
 .../annotations/should_compile/th/AnnHelper.hs     |   16 ++++++++++
 .../tests/annotations/should_compile/th/Makefile   |   33 ++++++++++++++++++++
 .../annotations/should_compile/th/TestModule.hs    |   11 +++++++
 .../annotations/should_compile/th/TestModuleTH.hs  |   18 +++++++++++
 .../tests/annotations/should_compile/th/all.T      |   18 +++++++++++
 .../tests/annotations/should_compile/th/annth.hs   |   26 +++++++++++++++
 .../should_compile/th/annth_compunits.stdout       |    7 +++++
 .../should_compile/th/annth_make.stdout            |    7 +++++
 8 files changed, 136 insertions(+)

diff --git a/testsuite/tests/annotations/should_compile/th/AnnHelper.hs b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs
new file mode 100644
index 0000000..ac0f040
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs
@@ -0,0 +1,16 @@
+module AnnHelper where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+traverseModuleAnnotations :: Q [String]
+traverseModuleAnnotations = do
+  ModuleInfo children <- reifyModule =<< thisModule
+  go children [] []
+  where
+    go []     _visited acc = return acc
+    go (x:xs) visited  acc | x `elem` visited = go xs visited acc
+                           | otherwise = do
+                             ModuleInfo newMods <- reifyModule x
+                             newAnns <- reifyAnnotations $ AnnLookupModule x
+                             go (newMods ++ xs) (x:visited) (newAnns ++ acc)
diff --git a/testsuite/tests/annotations/should_compile/th/Makefile b/testsuite/tests/annotations/should_compile/th/Makefile
new file mode 100644
index 0000000..4159eee
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/Makefile
@@ -0,0 +1,33 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+annth_make:
+	$(MAKE) clean_annth_make
+	mkdir build_make
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make \
+	   -odir build_make -hidir build_make -o build_make/annth annth.hs
+
+clean_annth_make:
+	rm -rf build_make
+
+annth_compunits:
+	$(MAKE) clean_annth_compunits
+	mkdir build_compunits
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c AnnHelper.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c TestModule.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c TestModuleTH.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -ibuild_compunits \
+	  -odir build_compunits -hidir build_compunits \
+	  -c annth.hs
+
+clean_annth_compunits:
+	rm -rf build_compunits
+
+.PHONY: annth_make clean_annth_make annth_compunits clean_annth_compunits
diff --git a/testsuite/tests/annotations/should_compile/th/TestModule.hs b/testsuite/tests/annotations/should_compile/th/TestModule.hs
new file mode 100644
index 0000000..d9519eb
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/TestModule.hs
@@ -0,0 +1,11 @@
+module TestModule where
+
+{-# ANN module "Module annotation" #-}
+
+{-# ANN type TestType "Type annotation" #-}
+{-# ANN TestType "Constructor annotation" #-}
+data TestType = TestType
+
+{-# ANN testValue "Value annotation" #-}
+testValue :: Int
+testValue = 42
diff --git a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
new file mode 100644
index 0000000..f21b137
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module TestModuleTH where
+
+import Language.Haskell.TH
+
+$(do
+     modAnn <- pragAnnD ModuleAnnotation
+                        (stringE "TH module annotation")
+     [typ] <- [d| data TestTypeTH = TestTypeTH |]
+     conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
+                        (stringE "TH Constructor annotation")
+     typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
+                        (stringE "TH Type annotation")
+     valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
+                        (stringE "TH Value annotation")
+     [val] <- [d| testValueTH = (42 :: Int) |]
+     return [modAnn, conAnn, typAnn, typ, valAnn, val] )
diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T
new file mode 100644
index 0000000..777cf3d
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/all.T
@@ -0,0 +1,18 @@
+setTestOpts(when(compiler_profiled(), skip))
+
+# Annotations and Template Haskell, require runtime evaluation.  In
+# order for this to work with profiling, we would have to build the
+# program twice and use -osuf p_o (see the TH_splitE5_prof test).  For
+# now, just disable the profiling ways.
+
+test('annth_make',
+     [req_interp, omit_ways(['profasm','profthreaded']),
+      clean_cmd('$MAKE -s clean_annth_make')],
+     run_command,
+     ['$MAKE -s --no-print-directory annth_make'])
+
+test('annth_compunits',
+     [req_interp, omit_ways(['profasm','profthreaded']),
+      clean_cmd('$MAKE -s clean_annth_compunits')],
+     run_command,
+     ['$MAKE -s --no-print-directory annth_compunits'])
diff --git a/testsuite/tests/annotations/should_compile/th/annth.hs b/testsuite/tests/annotations/should_compile/th/annth.hs
new file mode 100644
index 0000000..de5d4d3
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+import AnnHelper
+import TestModule
+import TestModuleTH
+
+main = do
+  $(do
+    anns <- traverseModuleAnnotations
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'testValue)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'testValueTH)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName ''TestType)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName ''TestTypeTH)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'TestType)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'TestTypeTH)
+    runIO $ print (anns :: [String])
+    [| return () |] )
diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
new file mode 100644
index 0000000..96e4642
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
@@ -0,0 +1,7 @@
+["TH module annotation","Module annotation"]
+["Value annotation"]
+["TH Value annotation"]
+["Type annotation"]
+["TH Type annotation"]
+["Constructor annotation"]
+["TH Constructor annotation"]
diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stdout b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
new file mode 100644
index 0000000..96e4642
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
@@ -0,0 +1,7 @@
+["TH module annotation","Module annotation"]
+["Value annotation"]
+["TH Value annotation"]
+["Type annotation"]
+["TH Type annotation"]
+["Constructor annotation"]
+["TH Constructor annotation"]



More information about the ghc-commits mailing list