Change CaseAlt and LambdaExpr to FunRhs in deriving Foldable and Traversable (#20496)

3 files changed, 56 insertions, 0 deletions

diff --git a/testsuite/tests/deriving/should_compile/T20496.hs b/testsuite/tests/deriving/should_compile/T20496.hs
new file mode 100644
index 0000000000..dc05ea9d22
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T20496.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DeriveFoldable, DeriveTraversable, EmptyDataDecls, RoleAnnotations #-}
+module T20496 where
+
+data T b = MkT b
+  deriving (Functor, Foldable, Traversable)
+
+data Trixie a
+  deriving (Functor, Foldable, Traversable)
+
+type role UhOh nominal
+data UhOh a
+  deriving (Functor, Foldable, Traversable)
+
+type role UhOh2 representational
+data UhOh2 a
+  deriving (Functor, Foldable, Traversable)
diff --git a/testsuite/tests/deriving/should_compile/T20496.stderr b/testsuite/tests/deriving/should_compile/T20496.stderr
new file mode 100644
index 0000000000..42257bc926
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T20496.stderr
@@ -0,0 +1,36 @@
+rnd
+  instance Functor UhOh2 where
+    fmap _ z = case z of {}
+    (<$) _ z = case z of {}
+  
+  instance Foldable UhOh2 where foldMap _ z = mempty
+  
+  instance Traversable UhOh2 where traverse _ z = pure (case z of {})
+  
+  instance Functor UhOh where
+    fmap _ z = case z of {}
+    (<$) _ z = case z of {}
+  
+  instance Foldable UhOh where foldMap _ z = mempty
+  
+  instance Traversable UhOh where traverse _ z = pure (case z of {})
+  
+  instance Functor Trixie where fmap _ = GHC.Prim.coerce
+  
+  instance Foldable Trixie where foldMap _ _ = mempty
+  
+  instance Traversable Trixie where
+    traverse _ z = pure (GHC.Prim.coerce z)
+  
+  instance Functor T where
+    fmap f (MkT a1) = MkT (f a1)
+    (<$) z (MkT a1) = MkT z
+  
+  instance Foldable T where
+    foldr f z (MkT a1) = f a1 z
+    foldMap f (MkT a1) = f a1
+    null (MkT _) = False
+  
+  instance Traversable T where
+    traverse f (MkT a1) = fmap (\ b1 -> MkT b1) (f a1)
+
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 97c3865f4b..87908020f6 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -128,3 +128,7 @@ test('T17880', normal, compile, [''])
 test('T18055', normal, compile, [''])
 test('T18321', normal, compile, [''])
 test('T18914', normal, compile, [''])
+# We need to find derived instances in the Tc trace dump.
+# They are printed in tcDeriv beginning with "rnd" line
+# and are indented with spaces.
+test('T20496', multiline_grep_errmsg(r"rnd\n( .*\n)*"), compile, ['-ddump-tc-trace'])