summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2016-10-11 16:25:05 -0400
committerJoachim Breitner <mail@joachim-breitner.de>2016-10-11 16:25:05 -0400
commitb5be2ec33c395e3e092baf85ebd0696f233ad706 (patch)
tree2b3f6cfd10326b09129a583b7d6a99b5eb57ad73
parenta6111b8cc14a5dc019e2613f6f634dec4eb57a8a (diff)
downloadhaskell-b5be2ec33c395e3e092baf85ebd0696f233ad706.tar.gz
Add test case for #12689
which test a few variants of rules involving constructors, including nullary constructors, constructors with wrappers, and unsaturated of constructors. At the moment, all the rules work as expected, despite GHC’s compile time warnings when called with -Wall.
-rw-r--r--testsuite/tests/simplCore/should_run/T12689.hs26
-rw-r--r--testsuite/tests/simplCore/should_run/T12689.stdout7
-rw-r--r--testsuite/tests/simplCore/should_run/T12689a.hs24
-rw-r--r--testsuite/tests/simplCore/should_run/T12689a.stdout5
-rw-r--r--testsuite/tests/simplCore/should_run/all.T2
5 files changed, 64 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_run/T12689.hs b/testsuite/tests/simplCore/should_run/T12689.hs
new file mode 100644
index 0000000000..84a5419a40
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T12689.hs
@@ -0,0 +1,26 @@
+data T1 = MkT1Bad | MkT1Good deriving Show
+data T2 = MkT2Bad Int | MkT2Good Int deriving Show
+data T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show
+data T4 = MkT4Bad Int | MkT4Good Int deriving Show
+data T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show
+
+{-# RULES
+
+"T1" MkT1Bad = MkT1Good
+"T2" forall x. MkT2Bad x = MkT2Good x
+"T3" forall x. MkT3Bad x = MkT3Good x
+"T4" MkT4Bad = MkT4Good
+"T5" MkT5Bad = MkT5Good
+ #-}
+
+app = id
+{-# NOINLINE app #-}
+
+main = do
+ print MkT1Bad
+ print (MkT2Bad 42)
+ print (MkT3Bad 42)
+ print (MkT4Bad 42)
+ print (app MkT4Bad 42)
+ print (MkT5Bad 42)
+ print (app MkT5Bad 42)
diff --git a/testsuite/tests/simplCore/should_run/T12689.stdout b/testsuite/tests/simplCore/should_run/T12689.stdout
new file mode 100644
index 0000000000..7e9baf3ba9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T12689.stdout
@@ -0,0 +1,7 @@
+MkT1Good
+MkT2Good 42
+MkT3Good 42
+MkT4Good 42
+MkT4Good 42
+MkT5Good 42
+MkT5Good 42
diff --git a/testsuite/tests/simplCore/should_run/T12689a.hs b/testsuite/tests/simplCore/should_run/T12689a.hs
new file mode 100644
index 0000000000..88fd5ee6cd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T12689a.hs
@@ -0,0 +1,24 @@
+data T1 = MkT1Bad | MkT1Good deriving Show
+data T2 = MkT2Bad Int | MkT2Good Int deriving Show
+data T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show
+data T4 = MkT4Bad Int | MkT4Good Int deriving Show
+data T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show
+
+{-# RULES
+
+"T1" app MkT1Bad = MkT1Good
+"T2" forall x. app (MkT2Bad x) = MkT2Good x
+"T3" forall x. app (MkT3Bad x) = MkT3Good x
+"T4" app MkT4Bad = MkT4Good
+"T5" app MkT5Bad = MkT5Good
+ #-}
+
+app = id
+{-# NOINLINE app #-}
+
+main = do
+ print (app MkT1Bad)
+ print (app (MkT2Bad 42))
+ print (app (MkT3Bad 42))
+ print (app MkT4Bad 42)
+ print (app MkT5Bad 42)
diff --git a/testsuite/tests/simplCore/should_run/T12689a.stdout b/testsuite/tests/simplCore/should_run/T12689a.stdout
new file mode 100644
index 0000000000..c924bde216
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T12689a.stdout
@@ -0,0 +1,5 @@
+MkT1Good
+MkT2Good 42
+MkT3Good 42
+MkT4Good 42
+MkT5Good 42
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 60a279a880..1e4e8a79b7 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -73,3 +73,5 @@ test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, [''])
test('T11172', normal, compile_and_run, [''])
test('T11731', normal, compile_and_run, ['-fspec-constr'])
test('T7611', normal, compile_and_run, [''])
+test('T12689', normal, compile_and_run, [''])
+test('T12689a', normal, compile_and_run, [''])