[commit: testsuite] master: Wibbles from new arrow typechecking code (3458e25)

[Simon Peyton Jones]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3458e253105142e96c94bf95c9807b60a05dec75

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

commit 3458e253105142e96c94bf95c9807b60a05dec75
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Mar 4 09:41:36 2013 +0000

    Wibbles from new arrow typechecking code
    Refactored to solve Trac #5609

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

 tests/arrows/should_compile/T5283.hs       |   12 ++++++------
 tests/arrows/should_compile/all.T          |    1 -
 tests/arrows/should_compile/arrowapply4.hs |   17 -----------------
 tests/arrows/should_compile/arrowform1.hs  |    4 ++--
 4 files changed, 8 insertions(+), 26 deletions(-)

diff --git a/tests/arrows/should_compile/T5283.hs b/tests/arrows/should_compile/T5283.hs
index 9216d3c..2878208 100644
--- a/tests/arrows/should_compile/T5283.hs
+++ b/tests/arrows/should_compile/T5283.hs
@@ -6,13 +6,13 @@ module T where
 import Prelude
 import Control.Arrow
 
-mapAC :: Arrow arr => Integer -> arr (env, b) c -> arr (env, [b]) [c]  
-mapAC n farr = go 1
+mapAC :: Arrow arr => Int -> arr (env, (b,())) c -> arr (env, ([b],())) [c]  
+mapAC n farr = go 0
   where
-    go i | i == succ n = arr (\(_env, []) -> [])
-         | otherwise = proc ~(env, b : bs) ->
-             do c  <- farr -< (env, b)
-                cs <- go (succ i) -< (env, bs)
+    go i | i == n = arr (\(_env, ([], ())) -> [])
+         | otherwise = proc ~(env, (b : bs, ())) ->
+             do c  <- farr -< (env, (b, ()))
+                cs <- go (i+1) -< (env, (bs, ()))
                 returnA -< c : cs
 
 t :: Arrow arr => arr [a] [a]
diff --git a/tests/arrows/should_compile/all.T b/tests/arrows/should_compile/all.T
index 0a1e651..5535e63 100644
--- a/tests/arrows/should_compile/all.T
+++ b/tests/arrows/should_compile/all.T
@@ -3,7 +3,6 @@ setTestOpts(only_compiler_types(['ghc']))
 test('arrowapply1', normal, compile, [''])
 test('arrowapply2', normal, compile, [''])
 test('arrowapply3', normal, compile, [''])
-test('arrowapply4', normal, compile, [''])
 test('arrowapply5', normal, compile, [''])
 test('arrowcase1', normal, compile, [''])
 test('arrowdo1', normal, compile, [''])
diff --git a/tests/arrows/should_compile/arrowapply4.hs b/tests/arrows/should_compile/arrowapply4.hs
deleted file mode 100644
index af0dac4..0000000
--- a/tests/arrows/should_compile/arrowapply4.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-module ShouldCompile where
-
--- example from Sebastian Boldt <Sebastian.Boldt at arcor.de>:
---	(f -< a) b  ===  f -< (a,b)
-
-import Control.Arrow
-
-mshowA :: (Arrow a, Show b) => a (b, String) String
-mshowA = proc (x,s) -> returnA -< s ++ show x ++ s
-
-f :: Arrow a => a Int String
-f = proc x -> (mshowA -< x) "***"
-
-g :: ArrowApply a => a Int String
-g = proc x -> (mshowA -<< x) "***"
diff --git a/tests/arrows/should_compile/arrowform1.hs b/tests/arrows/should_compile/arrowform1.hs
index a282d71..70b9669 100644
--- a/tests/arrows/should_compile/arrowform1.hs
+++ b/tests/arrows/should_compile/arrowform1.hs
@@ -4,8 +4,8 @@ module ShouldCompile where
 
 import Control.Arrow
 
-handle :: ArrowPlus a => a b c -> a (b,String) c -> a b c
-handle f h = proc b -> (f -< b) <+> (h -< (b,""))
+handle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c
+handle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,("FAIL",s)))
 
 f :: ArrowPlus a => a (Int,Int) String
 f = proc (x,y) ->