[commit: testsuite] master: Test Trac #7785 (8854b27)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

https://github.com/ghc/testsuite/commit/8854b2729de190e190d65a5d688a5b7250952aec

>---------------------------------------------------------------

commit 8854b2729de190e190d65a5d688a5b7250952aec
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu May 30 14:29:19 2013 +0100

    Test Trac #7785

>---------------------------------------------------------------

 tests/simplCore/should_compile/T7785.hs     |   28 +++++++++++++++++++++++++++
 tests/simplCore/should_compile/T7785.stderr |    9 ++++++++
 tests/simplCore/should_compile/all.T        |    1 +
 3 files changed, 38 insertions(+), 0 deletions(-)

diff --git a/tests/simplCore/should_compile/T7785.hs b/tests/simplCore/should_compile/T7785.hs
new file mode 100644
index 0000000..c6dacb7
--- /dev/null
+++ b/tests/simplCore/should_compile/T7785.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
+
+module Foo( shared, foo, bar) where
+
+import GHC.Exts
+
+type family Domain (f :: * -> *) a :: Constraint
+
+type instance Domain [] a = ()
+
+instance MyFunctor [] where
+  myfmap = map
+
+class MyFunctor f where
+  myfmap :: (Domain f a, Domain f b) => (a -> b) -> f a -> f b
+
+shared :: (MyFunctor f, Domain f Int) => f Int -> f Int
+shared = let
+  f = myfmap negate
+  in
+  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.
+  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.
+  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.
+  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.
+  f
+
+foo xs = shared $ 0:xs
+bar xs = 0:shared xs
diff --git a/tests/simplCore/should_compile/T7785.stderr b/tests/simplCore/should_compile/T7785.stderr
new file mode 100644
index 0000000..fbe217c
--- /dev/null
+++ b/tests/simplCore/should_compile/T7785.stderr
@@ -0,0 +1,9 @@
+
+==================== Tidy Core rules ====================
+"SPEC Foo.shared [[]]" [ALWAYS]
+    forall ($dMyFunctor :: Foo.MyFunctor [])
+           (irred :: Foo.Domain [] GHC.Types.Int).
+      Foo.shared @ [] $dMyFunctor irred
+      = Foo.bar_$sshared
+
+
diff --git a/tests/simplCore/should_compile/all.T b/tests/simplCore/should_compile/all.T
index c953346..a1d440e 100644
--- a/tests/simplCore/should_compile/all.T
+++ b/tests/simplCore/should_compile/all.T
@@ -166,3 +166,4 @@ test('T7796',
      ['$MAKE -s --no-print-directory T7796'])
 test('T5550', normal, compile, [''])
 test('T7865', normal, run_command, ['$MAKE -s --no-print-directory T7865'])
+test('T7785', only_ways(['optasm']), compile, ['-ddump-rules'])