Properly trim IdInfos of DFunIds and PatSyns in TidyPgm

Not doing this right caused #16608. We now properly trim IdInfos of
DFunIds and PatSyns.

Some further refactoring done by SPJ.

Two regression tests T16608_1 and T16608_2 added.

Fixes #16608

7 files changed, 66 insertions, 0 deletions

diff --git a/testsuite/tests/driver/T16608/Makefile b/testsuite/tests/driver/T16608/Makefile
new file mode 100644
index 0000000000..f3a6fae9be
--- /dev/null
+++ b/testsuite/tests/driver/T16608/Makefile
@@ -0,0 +1,17 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T16608_1:
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -O0 T16608_1.hs
+	./T16608_1
+	sed -i -e 's/{- . succ -}/. succ/' MyInteger.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -O0 T16608_1.hs
+	./T16608_1
+
+T16608_2:
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -O0 T16608_2.hs
+	./T16608_2
+	sed -i -e 's/{- . succ -}/. succ/' MyInteger.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -O0 T16608_2.hs
+	./T16608_2
diff --git a/testsuite/tests/driver/T16608/MyInteger.hs b/testsuite/tests/driver/T16608/MyInteger.hs
new file mode 100644
index 0000000000..a7c731ed8c
--- /dev/null
+++ b/testsuite/tests/driver/T16608/MyInteger.hs
@@ -0,0 +1,12 @@
+module MyInteger
+  ( MyInteger (MyInteger)
+  , ToMyInteger (toMyInteger)
+  ) where
+
+newtype MyInteger = MyInteger Integer
+
+class ToMyInteger a where
+  toMyInteger :: a -> MyInteger
+
+instance ToMyInteger Integer where
+  toMyInteger = MyInteger {- . succ -}
diff --git a/testsuite/tests/driver/T16608/T16608_1.hs b/testsuite/tests/driver/T16608/T16608_1.hs
new file mode 100644
index 0000000000..87a5000dab
--- /dev/null
+++ b/testsuite/tests/driver/T16608/T16608_1.hs
@@ -0,0 +1,11 @@
+module Main
+  ( main
+  ) where
+
+import MyInteger (MyInteger (MyInteger), toMyInteger)
+
+main :: IO ()
+main = do
+  let (MyInteger i) = toMyInteger (41 :: Integer)
+  print i
+
diff --git a/testsuite/tests/driver/T16608/T16608_1.stdout b/testsuite/tests/driver/T16608/T16608_1.stdout
new file mode 100644
index 0000000000..05c44cb5a8
--- /dev/null
+++ b/testsuite/tests/driver/T16608/T16608_1.stdout
@@ -0,0 +1,7 @@
+[1 of 2] Compiling MyInteger        ( MyInteger.hs, MyInteger.o )
+[2 of 2] Compiling Main             ( T16608_1.hs, T16608_1.o )
+Linking T16608_1 ...
+41
+[1 of 2] Compiling MyInteger        ( MyInteger.hs, MyInteger.o )
+Linking T16608_1 ...
+42
diff --git a/testsuite/tests/driver/T16608/T16608_2.hs b/testsuite/tests/driver/T16608/T16608_2.hs
new file mode 100644
index 0000000000..34eaddabf0
--- /dev/null
+++ b/testsuite/tests/driver/T16608/T16608_2.hs
@@ -0,0 +1,10 @@
+module Main
+  ( main
+  ) where
+
+import MyInteger (MyInteger (MyInteger), toMyInteger)
+
+main :: IO ()
+main = do
+  let (MyInteger i) = (id . toMyInteger) (41 :: Integer)
+  print i
diff --git a/testsuite/tests/driver/T16608/T16608_2.stdout b/testsuite/tests/driver/T16608/T16608_2.stdout
new file mode 100644
index 0000000000..9ca19a6dba
--- /dev/null
+++ b/testsuite/tests/driver/T16608/T16608_2.stdout
@@ -0,0 +1,7 @@
+[1 of 2] Compiling MyInteger        ( MyInteger.hs, MyInteger.o )
+[2 of 2] Compiling Main             ( T16608_2.hs, T16608_2.o )
+Linking T16608_2 ...
+41
+[1 of 2] Compiling MyInteger        ( MyInteger.hs, MyInteger.o )
+Linking T16608_2 ...
+42
diff --git a/testsuite/tests/driver/T16608/all.T b/testsuite/tests/driver/T16608/all.T
new file mode 100644
index 0000000000..5a1b8dc488
--- /dev/null
+++ b/testsuite/tests/driver/T16608/all.T
@@ -0,0 +1,2 @@
+test('T16608_1', [extra_files(['MyInteger.hs'])], makefile_test, [])
+test('T16608_2', [extra_files(['MyInteger.hs'])], makefile_test, [])