Commit 5f5e326c authored by Gergely Risko's avatar Gergely Risko Committed by Austin Seipp
Browse files

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: default avatarAustin Seipp <austin@well-typed.com>
parent 48e475e4
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)
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
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
{-# 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] )
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'])
{-# 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 () |] )
["TH module annotation","Module annotation"]
["Value annotation"]
["TH Value annotation"]
["Type annotation"]
["TH Type annotation"]
["Constructor annotation"]
["TH Constructor annotation"]
["TH module annotation","Module annotation"]
["Value annotation"]
["TH Value annotation"]
["Type annotation"]
["TH Type annotation"]
["Constructor annotation"]
["TH Constructor annotation"]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment