diff options
Diffstat (limited to 'testsuite/tests/th/overloaded')
11 files changed, 160 insertions, 0 deletions
diff --git a/testsuite/tests/th/overloaded/Makefile b/testsuite/tests/th/overloaded/Makefile new file mode 100644 index 0000000000..4a268530f1 --- /dev/null +++ b/testsuite/tests/th/overloaded/Makefile @@ -0,0 +1,4 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs b/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs new file mode 100644 index 0000000000..565ef41c1d --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints.hs @@ -0,0 +1,32 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module TH_overloaded_constraints where +-- Test that constraints are collected properly from nested splices + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Data.Functor.Identity + +class C m where + cid :: m a -> m a + +class D m where + did :: m a -> m a + +cq :: (C m, Quote m) => m Exp +cq = [| 5 |] + +dq :: (D m, Quote m) => m Exp +dq = [| 5 |] + +top_level :: (C m, D m, Quote m) => m Exp +top_level = [| $cq + $dq |] + +cqt :: (C m, Quote m) => m (TExp Int) +cqt = [|| 5 ||] + +dqt :: (D m, Quote m) => m (TExp Int) +dqt = [|| 5 ||] + +top_level_t :: (C m, D m, Quote m) => m (TExp Int) +top_level_t = [|| $$cqt + $$dqt ||] diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs new file mode 100644 index 0000000000..07c2163bbc --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module TH_overloaded_constraints_fail where +-- Test the error message when there are conflicting nested splices + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Data.Functor.Identity + +instance Quote Identity where + -- Not the correct implementation, just for testing + newName s = Identity (Name (mkOccName s) NameS) + +idQ :: Identity Exp +idQ = [| 5 |] + +qq :: Q Exp +qq = [| 5 |] + +quote = [| $(idQ) $(qq) |] diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr new file mode 100644 index 0000000000..d76db558c6 --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr @@ -0,0 +1,13 @@ + +TH_overloaded_constraints_fail.hs:20:14: error: + • Couldn't match type ‘Identity’ with ‘Q’ + Expected type: Q Exp + Actual type: Identity Exp + • In the expression: idQ + In the expression: + [| $(idQ) $(qq) |] + pending(rn) [<splice, qq>, <splice, idQ>] + In an equation for ‘quote’: + quote + = [| $(idQ) $(qq) |] + pending(rn) [<splice, qq>, <splice, idQ>] diff --git a/testsuite/tests/th/overloaded/TH_overloaded_csp.hs b/testsuite/tests/th/overloaded/TH_overloaded_csp.hs new file mode 100644 index 0000000000..c87707c01e --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_csp.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where +-- A test to check that CSP works with overloaded quotes + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Data.Functor.Identity + + +instance Quote Identity where + -- Not the correct implementation, just for testing + newName s = Identity (Name (mkOccName s) NameS) + +main = do + print $ runIdentity ((\x -> [| x |]) ()) + print $ unType $ runIdentity ((\x -> [|| x ||]) ()) + diff --git a/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout b/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout new file mode 100644 index 0000000000..5a64654110 --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_csp.stdout @@ -0,0 +1,2 @@ +ConE GHC.Tuple.() +ConE GHC.Tuple.() diff --git a/testsuite/tests/th/overloaded/TH_overloaded_extract.hs b/testsuite/tests/th/overloaded/TH_overloaded_extract.hs new file mode 100644 index 0000000000..23c5ac5257 --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_extract.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where +-- A simple test to check that defining a custom instance is easily +-- possible and extraction works as expected. + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Data.Functor.Identity + + +instance Quote Identity where + -- Not the correct implementation, just for testing + newName s = Identity (Name (mkOccName s) NameS) + +main = do + print $ runIdentity [| 1 + 2 |] + print $ runIdentity [| \x -> 1 + 2 |] + print $ runIdentity [d| data Foo = Foo |] + print $ runIdentity [p| () |] + print $ runIdentity [t| [Int] |] + print $ unType $ runIdentity [|| (+1) ||] + diff --git a/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout b/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout new file mode 100644 index 0000000000..e636c0c4f1 --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_extract.stdout @@ -0,0 +1,6 @@ +InfixE (Just (LitE (IntegerL 1))) (VarE GHC.Num.+) (Just (LitE (IntegerL 2))) +LamE [VarP x] (InfixE (Just (LitE (IntegerL 1))) (VarE GHC.Num.+) (Just (LitE (IntegerL 2)))) +[DataD [] Foo [] Nothing [NormalC Foo []] []] +ConP GHC.Tuple.() [] +AppT ListT (ConT GHC.Types.Int) +InfixE Nothing (VarE GHC.Num.+) (Just (LitE (IntegerL 1))) diff --git a/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs new file mode 100644 index 0000000000..18dd9e7a3e --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +module TH_overloaded_constraints_no_instance where +-- Test the error message when there is no instance + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +data NewType a + +-- No instance for Quote NewType +quote2 :: NewType Exp +quote2 = [| 5 |] + diff --git a/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr new file mode 100644 index 0000000000..78f70c4d85 --- /dev/null +++ b/testsuite/tests/th/overloaded/TH_overloaded_no_instance.stderr @@ -0,0 +1,5 @@ + +TH_overloaded_no_instance.hs:13:10: error: + • No instance for (Quote NewType) arising from a quotation bracket + • In the expression: [| 5 |] + In an equation for ‘quote2’: quote2 = [| 5 |] diff --git a/testsuite/tests/th/overloaded/all.T b/testsuite/tests/th/overloaded/all.T new file mode 100644 index 0000000000..e5c9194ee2 --- /dev/null +++ b/testsuite/tests/th/overloaded/all.T @@ -0,0 +1,23 @@ +# NOTICE TO DEVELOPERS +# ~~~~~~~~~~~~~~~~~~~~ +# Adding a TemplateHaskell test? If it only contains (non-quasi) quotes +# and no splices, consider adding it to the quotes/ directory instead +# of the th/ directory; this way, we can test it on the stage 1 compiler too! + +def f(name, opts): + opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' +setTestOpts(f) +setTestOpts(req_interp) +# TH should work with -fexternal-interpreter too +if config.have_ext_interp : + setTestOpts(extra_ways(['ext-interp'])) + setTestOpts(only_ways(['normal','ghci','ext-interp'])) + + if llvm_build(): + setTestOpts(fragile_for(16087, ['ext-interp'])) + +test('TH_overloaded_extract', normal, compile_and_run, ['']) +test('TH_overloaded_constraints', normal, compile, ['-v0']) +test('TH_overloaded_constraints_fail', normal, compile_fail, ['-v0']) +test('TH_overloaded_no_instance', normal, compile_fail, ['-v0']) +test('TH_overloaded_csp', normal, compile_and_run, ['-v0']) |