summaryrefslogtreecommitdiff
path: root/testsuite/tests/th
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/th')
-rw-r--r--testsuite/tests/th/T10598_TH.hs42
-rw-r--r--testsuite/tests/th/T10598_TH.stderr41
-rw-r--r--testsuite/tests/th/T10697_sourceUtil.hs2
-rw-r--r--testsuite/tests/th/T10819.hs3
-rw-r--r--testsuite/tests/th/T8100.hs4
-rw-r--r--testsuite/tests/th/TH_dataD1.hs2
-rw-r--r--testsuite/tests/th/all.T1
7 files changed, 90 insertions, 5 deletions
diff --git a/testsuite/tests/th/T10598_TH.hs b/testsuite/tests/th/T10598_TH.hs
new file mode 100644
index 0000000000..aab8bb3aa6
--- /dev/null
+++ b/testsuite/tests/th/T10598_TH.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T10598_TH where
+
+import Language.Haskell.TH
+
+class C a
+instance C Int
+
+class C a => D a
+instance D Int
+
+{-
+newtype Foo = MkFoo Int
+ deriving stock Eq
+ deriving anyclass C
+ deriving newtype Read
+
+deriving stock instance Ord Foo
+deriving anyclass instance D Foo
+deriving newtype instance Show Foo
+-}
+
+$(do fooDataName <- newName "Foo"
+ mkFooConName <- newName "MkFoo"
+ let fooType = conT fooDataName
+ sequence [ newtypeD (cxt []) fooDataName [] Nothing
+ (normalC mkFooConName
+ [ bangType (bang noSourceUnpackedness noSourceStrictness)
+ [t| Int |] ])
+ [ derivClause (Just Stock) [ [t| Eq |] ]
+ , derivClause (Just Anyclass) [ [t| C |] ]
+ , derivClause (Just Newtype) [ [t| Read |] ] ]
+ , standaloneDerivWithStrategyD (Just Stock)
+ (cxt []) [t| Ord $(fooType) |]
+ , standaloneDerivWithStrategyD (Just Anyclass)
+ (cxt []) [t| D $(fooType) |]
+ , standaloneDerivWithStrategyD (Just Newtype)
+ (cxt []) [t| Show $(fooType) |] ])
diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr
new file mode 100644
index 0000000000..bcfbb089c5
--- /dev/null
+++ b/testsuite/tests/th/T10598_TH.stderr
@@ -0,0 +1,41 @@
+T10598_TH.hs:(27,3)-(42,50): Splicing declarations
+ do { fooDataName <- newName "Foo";
+ mkFooConName <- newName "MkFoo";
+ let fooType = conT fooDataName;
+ sequence
+ [newtypeD
+ (cxt [])
+ fooDataName
+ []
+ Nothing
+ (normalC
+ mkFooConName
+ [bangType
+ (bang noSourceUnpackedness noSourceStrictness) [t| Int |]])
+ [derivClause (Just Stock) [[t| Eq |]],
+ derivClause (Just Anyclass) [[t| C |]],
+ derivClause (Just Newtype) [[t| Read |]]],
+ standaloneDerivWithStrategyD
+ (Just Stock)
+ (cxt [])
+ [t| Ord $fooType |]
+ pending(rn) [<splice, fooType>],
+ standaloneDerivWithStrategyD
+ (Just Anyclass)
+ (cxt [])
+ [t| D $fooType |]
+ pending(rn) [<splice, fooType>],
+ standaloneDerivWithStrategyD
+ (Just Newtype)
+ (cxt [])
+ [t| Show $fooType |]
+ pending(rn) [<splice, fooType>]] }
+ ======>
+ newtype Foo
+ = MkFoo Int
+ deriving stock (Eq)
+ deriving anyclass (C)
+ deriving newtype (Read)
+ deriving stock instance Ord Foo
+ deriving anyclass instance D Foo
+ deriving newtype instance Show Foo
diff --git a/testsuite/tests/th/T10697_sourceUtil.hs b/testsuite/tests/th/T10697_sourceUtil.hs
index 048a422b99..7ef60b79ae 100644
--- a/testsuite/tests/th/T10697_sourceUtil.hs
+++ b/testsuite/tests/th/T10697_sourceUtil.hs
@@ -10,7 +10,7 @@ makeSimpleDatatype :: Name
-> Q Dec
makeSimpleDatatype tyName conName srcUpk srcStr =
dataD (cxt []) tyName [] Nothing [normalC conName
- [bangType (bang srcUpk srcStr) (conT ''Int)]] (cxt [])
+ [bangType (bang srcUpk srcStr) (conT ''Int)]] []
checkBang :: Name
-> SourceUnpackednessQ
diff --git a/testsuite/tests/th/T10819.hs b/testsuite/tests/th/T10819.hs
index 0a217df479..265934be1a 100644
--- a/testsuite/tests/th/T10819.hs
+++ b/testsuite/tests/th/T10819.hs
@@ -16,7 +16,8 @@ data D = X
instance C Int D where
f X = 2
-$(doSomeTH "N" (mkName "D") [ConT (mkName "C") `AppT` ConT (mkName "Int")])
+$(doSomeTH "N" (mkName "D")
+ [DerivClause Nothing [ConT (mkName "C") `AppT` ConT (mkName "Int")]])
thing :: N
thing = N X
diff --git a/testsuite/tests/th/T8100.hs b/testsuite/tests/th/T8100.hs
index debc2f7166..3551251299 100644
--- a/testsuite/tests/th/T8100.hs
+++ b/testsuite/tests/th/T8100.hs
@@ -9,8 +9,8 @@ data Bar = Bar Int
$( do decs <- [d| deriving instance Eq a => Eq (Foo a)
deriving instance Ord a => Ord (Foo a) |]
- return ( StandaloneDerivD [] (ConT ''Eq `AppT` ConT ''Bar)
- : StandaloneDerivD [] (ConT ''Ord `AppT` ConT ''Bar)
+ return ( StandaloneDerivD Nothing [] (ConT ''Eq `AppT` ConT ''Bar)
+ : StandaloneDerivD Nothing [] (ConT ''Ord `AppT` ConT ''Bar)
: decs ) )
blah :: Ord a => Foo a -> Foo a -> Ordering
diff --git a/testsuite/tests/th/TH_dataD1.hs b/testsuite/tests/th/TH_dataD1.hs
index 1a51ac4aef..9d0c95b1a9 100644
--- a/testsuite/tests/th/TH_dataD1.hs
+++ b/testsuite/tests/th/TH_dataD1.hs
@@ -6,7 +6,7 @@ import Language.Haskell.TH
ds :: Q [Dec]
ds = [d|
$(do { d <- dataD (cxt []) (mkName "D") [] Nothing
- [normalC (mkName "K") []] (cxt [])
+ [normalC (mkName "K") []] []
; return [d]})
|]
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5d2fe3b051..d6a124c48e 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -368,6 +368,7 @@ test('T10267', extra_clean(['T10267a.hi', 'T10267a.o']),
test('T10279', normal, compile_fail, ['-v0'])
test('T10306', normal, compile, ['-v0'])
test('T10596', normal, compile, ['-v0'])
+test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices'])
test('T10620', normal, compile_and_run, ['-v0'])
test('T10638', normal, compile_fail, ['-v0'])
test('T10697_decided_1', normal, compile_and_run, ['-v0'])
View Lorry Controller Status