diff options
Diffstat (limited to 'testsuite')
41 files changed, 294 insertions, 18 deletions
diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py index 5af9695885..3f1e75b644 100644 --- a/testsuite/driver/extra_files.py +++ b/testsuite/driver/extra_files.py @@ -50,6 +50,7 @@ extra_src_files = { 'T10529c': ['.hpc/', 'hpc_sample_no_parse.tix'], 'T10576a': ['T10576.hs'], 'T10576b': ['T10576.hs'], + 'T10598': ['Test10598.hs'], 'T10637': ['A.hs', 'A.hs-boot'], 'T10672_x64': ['Main.hs', 'Printf.hs', 'cxxy.cpp'], 'T10672_x86': ['Main.hs', 'Printf.hs', 'cxxy.cpp'], diff --git a/testsuite/tests/deriving/should_fail/T10598_fail1.hs b/testsuite/tests/deriving/should_fail/T10598_fail1.hs new file mode 100644 index 0000000000..ee488869a4 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail1.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module T10598_fail1 where + +class Z f where + z :: f a b + +data A = A Int deriving newtype Show +newtype B = B Int deriving stock Num +data C a b = C Int deriving anyclass Z diff --git a/testsuite/tests/deriving/should_fail/T10598_fail1.stderr b/testsuite/tests/deriving/should_fail/T10598_fail1.stderr new file mode 100644 index 0000000000..0183ec515d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail1.stderr @@ -0,0 +1,17 @@ + +T10598_fail1.hs:9:40: error: + • Can't make a derived instance of + ‘Show A’ with the newtype strategy: + GeneralizedNewtypeDeriving cannot be used on non-newtypes + • In the data declaration for ‘A’ + +T10598_fail1.hs:10:40: error: + • Can't make a derived instance of ‘Num B’ with the stock strategy: + ‘Num’ is not a stock derivable class (Eq, Show, etc.) + • In the newtype declaration for ‘B’ + +T10598_fail1.hs:11:41: error: + • Can't make a derived instance of + ‘Z C’ with the anyclass strategy: + The last argument of class ‘Z’ does not have kind * or (* -> *) + • In the data declaration for ‘C’ diff --git a/testsuite/tests/deriving/should_fail/T10598_fail2.hs b/testsuite/tests/deriving/should_fail/T10598_fail2.hs new file mode 100644 index 0000000000..ba77fe0fbf --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail2.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DerivingStrategies #-} +module T10598_fail2 where + +data A = A Int deriving anyclass Eq +newtype B = B Int deriving newtype Eq diff --git a/testsuite/tests/deriving/should_fail/T10598_fail2.stderr b/testsuite/tests/deriving/should_fail/T10598_fail2.stderr new file mode 100644 index 0000000000..5ddd81dd1e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail2.stderr @@ -0,0 +1,12 @@ + +T10598_fail2.hs:4:37: error: + • Can't make a derived instance of + ‘Eq A’ with the anyclass strategy: + Try enabling DeriveAnyClass + • In the data declaration for ‘A’ + +T10598_fail2.hs:5:37: error: + • Can't make a derived instance of + ‘Eq B’ with the newtype strategy: + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + • In the newtype declaration for ‘B’ diff --git a/testsuite/tests/deriving/should_fail/T10598_fail3.hs b/testsuite/tests/deriving/should_fail/T10598_fail3.hs new file mode 100644 index 0000000000..23f9ad987f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail3.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE Safe #-} +module T10598_fail3 where + +import GHC.Generics + +data T = MkT Int deriving anyclass Generic diff --git a/testsuite/tests/deriving/should_fail/T10598_fail3.stderr b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr new file mode 100644 index 0000000000..a987a4993d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr @@ -0,0 +1,5 @@ + +T10598_fail3.hs:1:1: error: + Generic instances can only be derived in Safe Haskell using the stock strategy. + In the following instance: + instance [safe] Generic T diff --git a/testsuite/tests/deriving/should_fail/T10598_fail4.hs b/testsuite/tests/deriving/should_fail/T10598_fail4.hs new file mode 100644 index 0000000000..911111c8ea --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail4.hs @@ -0,0 +1,4 @@ +module T10598_fail4 where + +data Bar = Bar + deriving stock Eq diff --git a/testsuite/tests/deriving/should_fail/T10598_fail4.stderr b/testsuite/tests/deriving/should_fail/T10598_fail4.stderr new file mode 100644 index 0000000000..7d724d07bd --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail4.stderr @@ -0,0 +1,4 @@ + +T10598_fail4.hs:3:1: error: + Illegal deriving strategy: stock + Use DerivingStrategies to enable this extension diff --git a/testsuite/tests/deriving/should_fail/T10598_fail5.hs b/testsuite/tests/deriving/should_fail/T10598_fail5.hs new file mode 100644 index 0000000000..74f57fd307 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail5.hs @@ -0,0 +1,5 @@ +module T10598_fail5 where + +data Foo = Foo + deriving Eq + deriving Ord diff --git a/testsuite/tests/deriving/should_fail/T10598_fail5.stderr b/testsuite/tests/deriving/should_fail/T10598_fail5.stderr new file mode 100644 index 0000000000..af38cdcc51 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail5.stderr @@ -0,0 +1,4 @@ + +T10598_fail5.hs:3:1: error: + Illegal use of multiple, consecutive deriving clauses + Use DerivingStrategies to allow this diff --git a/testsuite/tests/deriving/should_fail/T10598_fail6.hs b/testsuite/tests/deriving/should_fail/T10598_fail6.hs new file mode 100644 index 0000000000..673bfcc971 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail6.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module T10598_fail6 where + +newtype F x = F ([x], Maybe x) deriving Functor diff --git a/testsuite/tests/deriving/should_fail/T10598_fail6.stderr b/testsuite/tests/deriving/should_fail/T10598_fail6.stderr new file mode 100644 index 0000000000..a80e5bab56 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T10598_fail6.stderr @@ -0,0 +1,6 @@ + +T10598_fail6.hs:5:41: error: + • Can't make a derived instance of ‘Functor F’ + (even with cunning GeneralizedNewtypeDeriving): + You need DeriveFunctor to derive an instance for this class + • In the newtype declaration for ‘F’ diff --git a/testsuite/tests/deriving/should_fail/T3833.stderr b/testsuite/tests/deriving/should_fail/T3833.stderr index da7da919bc..bf9a59cb8a 100644 --- a/testsuite/tests/deriving/should_fail/T3833.stderr +++ b/testsuite/tests/deriving/should_fail/T3833.stderr @@ -1,6 +1,6 @@ T3833.hs:9:1: error: Can't make a derived instance of ‘Monoid (DecodeMap e)’: - ‘Monoid’ is not a standard derivable class (Eq, Show, etc.) + ‘Monoid’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension In the stand-alone deriving instance for ‘Monoid (DecodeMap e)’ diff --git a/testsuite/tests/deriving/should_fail/T3834.stderr b/testsuite/tests/deriving/should_fail/T3834.stderr index 3eec64a6c5..9d2223e1f8 100644 --- a/testsuite/tests/deriving/should_fail/T3834.stderr +++ b/testsuite/tests/deriving/should_fail/T3834.stderr @@ -1,6 +1,6 @@ T3834.hs:8:1: error: Can't make a derived instance of ‘C T’: - ‘C’ is not a standard derivable class (Eq, Show, etc.) + ‘C’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension In the stand-alone deriving instance for ‘C T’ diff --git a/testsuite/tests/deriving/should_fail/T9600.stderr b/testsuite/tests/deriving/should_fail/T9600.stderr index 2e88277f54..5c03f2efc2 100644 --- a/testsuite/tests/deriving/should_fail/T9600.stderr +++ b/testsuite/tests/deriving/should_fail/T9600.stderr @@ -1,6 +1,6 @@ T9600.hs:3:39: error: Can't make a derived instance of ‘Applicative Foo’: - ‘Applicative’ is not a standard derivable class (Eq, Show, etc.) + ‘Applicative’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension In the newtype declaration for ‘Foo’ diff --git a/testsuite/tests/deriving/should_fail/T9968a.stderr b/testsuite/tests/deriving/should_fail/T9968a.stderr index 9f52b2efa9..a72563162e 100644 --- a/testsuite/tests/deriving/should_fail/T9968a.stderr +++ b/testsuite/tests/deriving/should_fail/T9968a.stderr @@ -1,6 +1,6 @@ T9968a.hs:8:13: error: • Can't make a derived instance of ‘Bifunctor Blah’: - ‘Bifunctor’ is not a standard derivable class (Eq, Show, etc.) + ‘Bifunctor’ is not a stock derivable class (Eq, Show, etc.) The last argument of class ‘Bifunctor’ does not have kind * or (* -> *) • In the data declaration for ‘Blah’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index bcb410b6ef..aebfa9e470 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -58,4 +58,10 @@ test('T9687', normal, compile_fail, ['']) test('T8984', normal, compile_fail, ['']) test('T9968a', normal, compile_fail, ['']) +test('T10598_fail1', normal, compile_fail, ['']) +test('T10598_fail2', normal, compile_fail, ['']) +test('T10598_fail3', normal, compile_fail, ['']) +test('T10598_fail4', normal, compile_fail, ['']) +test('T10598_fail5', normal, compile_fail, ['']) +test('T10598_fail6', normal, compile_fail, ['']) test('T12163', normal, compile_fail, ['']) diff --git a/testsuite/tests/deriving/should_fail/drvfail008.stderr b/testsuite/tests/deriving/should_fail/drvfail008.stderr index bfa73927c9..dcd43eca62 100644 --- a/testsuite/tests/deriving/should_fail/drvfail008.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail008.stderr @@ -1,6 +1,6 @@ drvfail008.hs:10:43: error: • Can't make a derived instance of ‘Monad M’: - ‘Monad’ is not a standard derivable class (Eq, Show, etc.) + ‘Monad’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension • In the newtype declaration for ‘M’ diff --git a/testsuite/tests/deriving/should_run/T10598_bug.hs b/testsuite/tests/deriving/should_run/T10598_bug.hs new file mode 100644 index 0000000000..e34d2c24ee --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10598_bug.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Main where + +newtype MyMaybe a = MyMaybe (Maybe a) + deriving (Functor, Show) + +main :: IO () +main = print $ fmap (+1) $ MyMaybe $ Just (10 :: Int) diff --git a/testsuite/tests/deriving/should_run/T10598_bug.stdout b/testsuite/tests/deriving/should_run/T10598_bug.stdout new file mode 100644 index 0000000000..31d7367d82 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10598_bug.stdout @@ -0,0 +1 @@ +MyMaybe (Just 11) diff --git a/testsuite/tests/deriving/should_run/T10598_run.hs b/testsuite/tests/deriving/should_run/T10598_run.hs new file mode 100644 index 0000000000..96238d70f8 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10598_run.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +module Main where + +import Data.Proxy + +class C a where + c :: proxy a -> Int + c _ = 42 + +instance C Int where + c _ = 27 + +newtype Foo = MkFoo Int + deriving Eq + deriving anyclass C +deriving newtype instance Show Foo + +main :: IO () +main = do + print $ MkFoo 100 + print $ c (Proxy :: Proxy Foo) diff --git a/testsuite/tests/deriving/should_run/T10598_run.stdout b/testsuite/tests/deriving/should_run/T10598_run.stdout new file mode 100644 index 0000000000..74a3087e37 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T10598_run.stdout @@ -0,0 +1,2 @@ +100 +42 diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index 29e8bbd250..ede2f90140 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -40,5 +40,7 @@ test('T9576', exit_code(1), compile_and_run, ['']) test('T9830', extra_clean(['T9830a.hi', 'T9830a.o']), multimod_compile_and_run, ['T9830','-v0']) test('T10104', normal, compile_and_run, ['']) test('T10447', normal, compile_and_run, ['']) +test('T10598_bug', normal, compile_and_run, ['']) +test('T10598_run', normal, compile_and_run, ['']) test('T11535', when(opsys('mingw32'), expect_broken_for(12210, ['ghci'])), compile_and_run, ['']) diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 45e257e4ec..0bef4c5632 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -40,7 +40,8 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", "TypeFamilyDependencies", - "UnboxedSums"] + "UnboxedSums", + "DerivingStrategies"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", diff --git a/testsuite/tests/generics/T5462No1.stderr b/testsuite/tests/generics/T5462No1.stderr index 7c1aec8d79..c82f1b86ee 100644 --- a/testsuite/tests/generics/T5462No1.stderr +++ b/testsuite/tests/generics/T5462No1.stderr @@ -3,18 +3,18 @@ T5462No1.hs:24:42: error: Can't make a derived instance of ‘GFunctor F’: - ‘GFunctor’ is not a standard derivable class (Eq, Show, etc.) + ‘GFunctor’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension In the newtype declaration for ‘F’ T5462No1.hs:26:23: error: Can't make a derived instance of ‘C1 G’: - ‘C1’ is not a standard derivable class (Eq, Show, etc.) + ‘C1’ is not a stock derivable class (Eq, Show, etc.) Try enabling DeriveAnyClass In the data declaration for ‘G’ T5462No1.hs:27:23: error: Can't make a derived instance of ‘C2 H’: - ‘C2’ is not a standard derivable class (Eq, Show, etc.) + ‘C2’ is not a stock derivable class (Eq, Show, etc.) Try enabling DeriveAnyClass In the data declaration for ‘H’ diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index c557c66624..158dadb72c 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -112,6 +112,10 @@ T11018: T10276: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10276.hs +.PHONY: T10598 +T10598: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10598.hs + .PHONY: T11321 T11321: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11321.hs diff --git a/testsuite/tests/ghc-api/annotations/T10598.stdout b/testsuite/tests/ghc-api/annotations/T10598.stdout new file mode 100644 index 0000000000..21029da26d --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T10598.stdout @@ -0,0 +1,36 @@ +---Problems (should be empty list)--- +[] +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test10598.hs:1:1,AnnModule), [Test10598.hs:5:1-6]), +((Test10598.hs:1:1,AnnWhere), [Test10598.hs:5:18-22]), +((Test10598.hs:(7,1)-(9,10),AnnClass), [Test10598.hs:7:1-5]), +((Test10598.hs:(7,1)-(9,10),AnnSemi), [Test10598.hs:11:1]), +((Test10598.hs:(7,1)-(9,10),AnnWhere), [Test10598.hs:7:11-15]), +((Test10598.hs:8:3-21,AnnDcolon), [Test10598.hs:8:5-6]), +((Test10598.hs:8:3-21,AnnSemi), [Test10598.hs:9:3]), +((Test10598.hs:8:8-21,AnnRarrow), [Test10598.hs:8:16-17]), +((Test10598.hs:9:3-10,AnnEqual), [Test10598.hs:9:7]), +((Test10598.hs:9:3-10,AnnFunId), [Test10598.hs:9:3]), +((Test10598.hs:(11,1)-(12,10),AnnInstance), [Test10598.hs:11:1-8]), +((Test10598.hs:(11,1)-(12,10),AnnSemi), [Test10598.hs:14:1]), +((Test10598.hs:(11,1)-(12,10),AnnWhere), [Test10598.hs:11:16-20]), +((Test10598.hs:12:3-10,AnnEqual), [Test10598.hs:12:7]), +((Test10598.hs:12:3-10,AnnFunId), [Test10598.hs:12:3]), +((Test10598.hs:(14,1)-(17,21),AnnEqual), [Test10598.hs:14:13]), +((Test10598.hs:(14,1)-(17,21),AnnNewtype), [Test10598.hs:14:1-7]), +((Test10598.hs:(14,1)-(17,21),AnnSemi), [Test10598.hs:18:1]), +((Test10598.hs:15:3-22,AnnDeriving), [Test10598.hs:15:3-10]), +((Test10598.hs:16:3-23,AnnDeriving), [Test10598.hs:16:3-10]), +((Test10598.hs:16:12-16,AnnStock), [Test10598.hs:16:12-16]), +((Test10598.hs:17:3-21,AnnDeriving), [Test10598.hs:17:3-10]), +((Test10598.hs:17:12-19,AnnAnyclass), [Test10598.hs:17:12-19]), +((Test10598.hs:18:1-34,AnnDeriving), [Test10598.hs:18:1-8]), +((Test10598.hs:18:1-34,AnnInstance), [Test10598.hs:18:18-25]), +((Test10598.hs:18:1-34,AnnSemi), [Test10598.hs:19:1]), +((Test10598.hs:18:10-16,AnnNewtype), [Test10598.hs:18:10-16]), +((<no location info>,AnnEofPos), [Test10598.hs:19:1]) +] + diff --git a/testsuite/tests/ghc-api/annotations/Test10598.hs b/testsuite/tests/ghc-api/annotations/Test10598.hs new file mode 100644 index 0000000000..8a7651c154 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test10598.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +module Test10598 where + +class C a where + c :: proxy a -> Int + c _ = 42 + +instance C Int where + c _ = 27 + +newtype Foo = MkFoo Int + deriving Eq + deriving stock Ord + deriving anyclass C +deriving newtype instance Show Foo diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index c14153dfbb..fac5d56658 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -21,6 +21,7 @@ test('T10313', normal, run_command, ['$MAKE -s --no-print-directory T10313' test('T11018', normal, run_command, ['$MAKE -s --no-print-directory T11018']) test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundle-export']) test('T10276', normal, run_command, ['$MAKE -s --no-print-directory T10276']) +test('T10598', normal, run_command, ['$MAKE -s --no-print-directory T10598']) test('T11321', normal, run_command, ['$MAKE -s --no-print-directory T11321']) test('T11332', normal, run_command, ['$MAKE -s --no-print-directory T11332']) test('T11430', normal, run_command, ['$MAKE -s --no-print-directory T11430']) diff --git a/testsuite/tests/module/mod53.stderr b/testsuite/tests/module/mod53.stderr index a4c176d11a..754c4524a5 100644 --- a/testsuite/tests/module/mod53.stderr +++ b/testsuite/tests/module/mod53.stderr @@ -1,6 +1,6 @@ mod53.hs:4:22: error: Can't make a derived instance of ‘C T’: - ‘C’ is not a standard derivable class (Eq, Show, etc.) + ‘C’ is not a stock derivable class (Eq, Show, etc.) Try enabling DeriveAnyClass In the data declaration for ‘T’ diff --git a/testsuite/tests/parser/should_fail/readFail039.stderr b/testsuite/tests/parser/should_fail/readFail039.stderr index 91b9a16553..be948f0a07 100644 --- a/testsuite/tests/parser/should_fail/readFail039.stderr +++ b/testsuite/tests/parser/should_fail/readFail039.stderr @@ -1,6 +1,6 @@ readFail039.hs:8:14: error: Can't make a derived instance of ‘C Foo’: - ‘C’ is not a standard derivable class (Eq, Show, etc.) + ‘C’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension In the newtype declaration for ‘Foo’ diff --git a/testsuite/tests/rts/T7919A.hs b/testsuite/tests/rts/T7919A.hs index ddbdb04750..cfcb329517 100644 --- a/testsuite/tests/rts/T7919A.hs +++ b/testsuite/tests/rts/T7919A.hs @@ -23,7 +23,7 @@ largeData = [normalC dataName (replicate size (((,) <$> bang noSourceUnpackedness noSourceStrictness) `ap` [t| Int |]))] - (cxt []) + [] conE' :: Name -> [ExpQ] -> ExpQ conE' n es = foldl appE (conE n) es diff --git a/testsuite/tests/safeHaskell/ghci/p16.stderr b/testsuite/tests/safeHaskell/ghci/p16.stderr index 4b445166d2..52315cce17 100644 --- a/testsuite/tests/safeHaskell/ghci/p16.stderr +++ b/testsuite/tests/safeHaskell/ghci/p16.stderr @@ -4,7 +4,7 @@ <interactive>:15:29: error: • Can't make a derived instance of ‘Op T2’: - ‘Op’ is not a standard derivable class (Eq, Show, etc.) + ‘Op’ is not a stock derivable class (Eq, Show, etc.) Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension • In the newtype declaration for ‘T2’ 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']) |