[commit: testsuite] master: Test Trac #7748 (c746006)

[Simon Peyton Jones]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/c746006174cb63a84dcdd7929af9c7f2f17ae05d

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

commit c746006174cb63a84dcdd7929af9c7f2f17ae05d
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Mar 9 16:31:04 2013 +0000

    Test Trac #7748

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

 tests/typecheck/should_fail/T7748a.hs              |   36 ++++++++++++++++++
 tests/typecheck/should_fail/T7748a.stderr          |   18 +++++++++
 tests/typecheck/should_fail/all.T                  |    1 +
 tests/typecheck/should_run/T7748.hs                |   40 ++++++++++++++++++++
 .../should_run/T7748.stdout}                       |    0 
 tests/typecheck/should_run/all.T                   |    1 +
 6 files changed, 96 insertions(+), 0 deletions(-)

diff --git a/tests/typecheck/should_fail/T7748a.hs b/tests/typecheck/should_fail/T7748a.hs
new file mode 100644
index 0000000..0929de3
--- /dev/null
+++ b/tests/typecheck/should_fail/T7748a.hs
@@ -0,0 +1,36 @@
+-- Correct type, which is inferred by GHC 7.6.1 and
+-- works fine with GHC 7.6.2:
+-- test :: Maybe (Maybe (r -> ())) -> r -> ()
+
+-- Incorrect type, resulting in a runtime <<loop>>,
+-- inferred by GHC 7.6.2 and also accepted by GHC 7.6.1:
+-- test :: a -> r -> ()
+
+module T7748a where
+
+test :: a -> r -> ()
+test zd
+ = let f = let g = case zd of
+                       Nothing       -> const ()
+                       Just Nothing  -> const ()
+                       Just (Just p) -> p
+           in  g
+   in f
+
+
+
+{-
+There is a bug in the type checker of 7.6.1 and 7.6.2, which accepts
+an incorrect type resulting in <<loop>> at runtime. Furthermore, 7.6.2
+even automatically infers this incorrect type. Hence, the attached
+code has the following behavior:
+
+- No explicit type: Code works in 7.6.1, loops in 7.6.2 
+- Correct explicit type: Code works fine in 7.6.1 and 7.6.2 
+- Incorrect explicit type: Code loops in 7.6.1 and 7.6.2
+
+The incorrect type has a parameter that is too polymorphic, i.e. an
+"a" type is accepted while the function does a pattern match on the
+parameter from which it is clear that it should be a Maybe type. In
+7.4.* versions this incorrect type is not accepted.
+-}
\ No newline at end of file
diff --git a/tests/typecheck/should_fail/T7748a.stderr b/tests/typecheck/should_fail/T7748a.stderr
new file mode 100644
index 0000000..f9204a1
--- /dev/null
+++ b/tests/typecheck/should_fail/T7748a.stderr
@@ -0,0 +1,18 @@
+
+T7748a.hs:14:24:
+    Couldn't match expected type ‛a’
+                with actual type ‛Maybe (Maybe (r -> ()))’
+      ‛a’ is a rigid type variable bound by
+          the type signature for test :: a -> r -> () at T7748a.hs:11:9
+    Relevant bindings include
+      test :: a -> r -> () (bound at T7748a.hs:12:1)
+      zd :: a (bound at T7748a.hs:12:6)
+      f :: r -> () (bound at T7748a.hs:13:8)
+      g :: r -> () (bound at T7748a.hs:13:16)
+    In the pattern: Nothing
+    In a case alternative: Nothing -> const ()
+    In the expression:
+      case zd of {
+        Nothing -> const ()
+        Just Nothing -> const ()
+        Just (Just p) -> p }
diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T
index 284f60d..bb4d220 100644
--- a/tests/typecheck/should_fail/all.T
+++ b/tests/typecheck/should_fail/all.T
@@ -300,3 +300,4 @@ test('T2354', normal, compile_fail, ['-O'])
 test('T7734', normal, compile_fail, [''])
 test('T7697', normal, compile_fail, [''])
 test('T7696', normal, compile_fail, [''])
+test('T7748a', normal, compile_fail, [''])
diff --git a/tests/typecheck/should_run/T7748.hs b/tests/typecheck/should_run/T7748.hs
new file mode 100644
index 0000000..16b566f
--- /dev/null
+++ b/tests/typecheck/should_run/T7748.hs
@@ -0,0 +1,40 @@
+-- Correct type, which is inferred by GHC 7.6.1 and
+-- works fine with GHC 7.6.2:
+-- test :: Maybe (Maybe (r -> ())) -> r -> ()
+
+-- Incorrect type, resulting in a runtime <<loop>>,
+-- inferred by GHC 7.6.2 and also accepted by GHC 7.6.1:
+-- test :: a -> r -> ()
+
+module Main where
+
+test zd
+ = let f = let g = case zd of
+                       Nothing       -> const ()
+                       Just Nothing  -> const ()
+                       Just (Just p) -> p
+           in  g
+   in f
+
+main :: IO ()
+main = do
+  let x = test (Just Nothing) ()
+  print x
+
+
+
+{-
+There is a bug in the type checker of 7.6.1 and 7.6.2, which accepts
+an incorrect type resulting in <<loop>> at runtime. Furthermore, 7.6.2
+even automatically infers this incorrect type. Hence, the attached
+code has the following behavior:
+
+- No explicit type: Code works in 7.6.1, loops in 7.6.2 
+- Correct explicit type: Code works fine in 7.6.1 and 7.6.2 
+- Incorrect explicit type: Code loops in 7.6.1 and 7.6.2
+
+The incorrect type has a parameter that is too polymorphic, i.e. an
+"a" type is accepted while the function does a pattern match on the
+parameter from which it is clear that it should be a Maybe type. In
+7.4.* versions this incorrect type is not accepted.
+-}
\ No newline at end of file
diff --git a/tests/codeGen/should_run/T3207.stdout b/tests/typecheck/should_run/T7748.stdout
similarity index 100%
copy from tests/codeGen/should_run/T3207.stdout
copy to tests/typecheck/should_run/T7748.stdout
diff --git a/tests/typecheck/should_run/all.T b/tests/typecheck/should_run/all.T
index b5ffa8c..0049769 100755
--- a/tests/typecheck/should_run/all.T
+++ b/tests/typecheck/should_run/all.T
@@ -107,3 +107,4 @@ test('T7126', normal, compile_and_run, [''])
 test('T6117', normal, compile_and_run, [''])
 test('T5751', normal, compile_and_run, [''])
 test('T5913', normal, compile_and_run, [''])
+test('T7748', normal, compile_and_run, [''])