[commit: ghc] ghc-7.8: Add a comprehensive test for using Annotations from TH (bd6eea9)
git at git.haskell.org
git at git.haskell.org
Tue Apr 29 21:10:23 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-7.8
Link : http://ghc.haskell.org/trac/ghc/changeset/bd6eea9f405ad195bcc70d7738bc33c6170cdc94/ghc
>---------------------------------------------------------------
commit bd6eea9f405ad195bcc70d7738bc33c6170cdc94
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>
(cherry picked from commit 5f5e326c3c310c4bceb2b0bce291d3a0a3fc30d6)
>---------------------------------------------------------------
bd6eea9f405ad195bcc70d7738bc33c6170cdc94
.../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