diff options
Diffstat (limited to 'testsuite/tests/arrows')
44 files changed, 1165 insertions, 0 deletions
diff --git a/testsuite/tests/arrows/Makefile b/testsuite/tests/arrows/Makefile new file mode 100644 index 0000000000..9a36a1c5fe --- /dev/null +++ b/testsuite/tests/arrows/Makefile @@ -0,0 +1,3 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/arrows/should_compile/Makefile b/testsuite/tests/arrows/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/arrows/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/arrows/should_compile/T3964.hs b/testsuite/tests/arrows/should_compile/T3964.hs new file mode 100644 index 0000000000..713c7e2303 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/T3964.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE Arrows, ViewPatterns #-} + +module T3964 where + +import Control.Arrow + +testF :: Eq a => a -> (Maybe (Maybe a)) -> Maybe a +testF v = proc x -> case x of + Just (Just ((==v) -> True)) -> returnA -< Just v + _ -> returnA -< Nothing diff --git a/testsuite/tests/arrows/should_compile/T5283.hs b/testsuite/tests/arrows/should_compile/T5283.hs new file mode 100644 index 0000000000..9216d3cd67 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/T5283.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE Arrows #-} +-- Failed in ghci + +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 + where + go i | i == succ n = arr (\(_env, []) -> []) + | otherwise = proc ~(env, b : bs) -> + do c <- farr -< (env, b) + cs <- go (succ i) -< (env, bs) + returnA -< c : cs + +t :: Arrow arr => arr [a] [a] +t = proc ys -> + (| (mapAC 3) (\y -> returnA -< y) |) ys diff --git a/testsuite/tests/arrows/should_compile/all.T b/testsuite/tests/arrows/should_compile/all.T new file mode 100644 index 0000000000..3351b9f4ba --- /dev/null +++ b/testsuite/tests/arrows/should_compile/all.T @@ -0,0 +1,18 @@ +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, ['']) +test('arrowdo2', normal, compile, ['']) +# test('arrowdo3', normal, compile, ['']) # takes too long +test('arrowform1', normal, compile, ['']) +test('arrowif1', normal, compile, ['']) +test('arrowlet1', normal, compile, ['']) +test('arrowrec1', normal, compile, ['']) +test('arrowpat', normal, compile, ['']) +test('T3964', normal, compile, ['']) +test('T5283', normal, compile, ['']) diff --git a/testsuite/tests/arrows/should_compile/arrowapply1.hs b/testsuite/tests/arrows/should_compile/arrowapply1.hs new file mode 100644 index 0000000000..abad47de26 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowapply1.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: Arrow a => a (Int,Int,Int) Int +f = proc (x,y,z) -> returnA -< x+y diff --git a/testsuite/tests/arrows/should_compile/arrowapply2.hs b/testsuite/tests/arrows/should_compile/arrowapply2.hs new file mode 100644 index 0000000000..16cf2f3039 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowapply2.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: ArrowApply a => a (a Int Int,Int,Int) Int +f = proc (x,y,z) -> x -<< 2+y + +g :: ArrowApply a => Int -> a (a Int Int,Int) Int +g y = proc (x,z) -> x -<< 2+y diff --git a/testsuite/tests/arrows/should_compile/arrowapply3.hs b/testsuite/tests/arrows/should_compile/arrowapply3.hs new file mode 100644 index 0000000000..3a9b49da92 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowapply3.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +g :: Arrow a => a Int c -> a Int c +g f = proc b -> f -< b+2 diff --git a/testsuite/tests/arrows/should_compile/arrowapply4.hs b/testsuite/tests/arrows/should_compile/arrowapply4.hs new file mode 100644 index 0000000000..af0dac4cee --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowapply4.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +-- example from Sebastian Boldt <Sebastian.Boldt@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/testsuite/tests/arrows/should_compile/arrowapply5.hs b/testsuite/tests/arrows/should_compile/arrowapply5.hs new file mode 100644 index 0000000000..46d1dc587f --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowapply5.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +-- variables bound inside the left argument of -< should be in scope + +import Control.Arrow + +f :: (Num b, Arrow a) => a b b +f = proc x -> arr (\y -> y-1) -< x + +g :: (Num b, Arrow a) => a b b +g = proc x -> (proc y -> returnA -< y-1) -< x diff --git a/testsuite/tests/arrows/should_compile/arrowcase1.hs b/testsuite/tests/arrows/should_compile/arrowcase1.hs new file mode 100644 index 0000000000..6d39b0be73 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowcase1.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +h :: ArrowChoice a => Int -> a (Int,Int) Int +h x = proc (y,z) -> case compare x y of + LT -> returnA -< x + EQ -> returnA -< y+z + GT -> returnA -< z+x + +g :: ArrowChoice a => Int -> a (Int,Int) Int +g x = proc (y,z) -> (case compare x y of + LT -> \ a -> returnA -< x+a + EQ -> \ b -> returnA -< y+z+b + GT -> \ c -> returnA -< z+x + ) 1 diff --git a/testsuite/tests/arrows/should_compile/arrowdo1.hs b/testsuite/tests/arrows/should_compile/arrowdo1.hs new file mode 100644 index 0000000000..b70eedd460 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowdo1.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: Arrow a => a (Int,Int,Int) Int +f = proc (x,y,z) -> returnA -< x+y + +g :: Arrow a => Int -> a Int Int +g x = proc y -> returnA -< x*y + +h :: Arrow a => Int -> a (Int,Int) Int +h x = proc (y,z) -> do + a <- f -< (x,y,3) + b <- g (2+x) -< y+a + returnA -< a*b+z diff --git a/testsuite/tests/arrows/should_compile/arrowdo2.hs b/testsuite/tests/arrows/should_compile/arrowdo2.hs new file mode 100644 index 0000000000..3562dc23b9 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowdo2.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: Arrow a => a (Int,Int) Int +f = proc (x,y) -> do + let z = x*y + returnA -< y+z diff --git a/testsuite/tests/arrows/should_compile/arrowdo3.hs b/testsuite/tests/arrows/should_compile/arrowdo3.hs new file mode 100644 index 0000000000..3b6a8c8d35 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowdo3.hs @@ -0,0 +1,222 @@ +{-# LANGUAGE Arrows #-} + +-- test for out-size tuples: takes a _long_ time to compile + +module ShouldCompile where + +import Control.Arrow + +data T1 = C1 +data T2 = C2 +data T3 = C3 +data T4 = C4 +data T5 = C5 +data T6 = C6 +data T7 = C7 +data T8 = C8 +data T9 = C9 +data T10 = C10 +data T11 = C11 +data T12 = C12 +data T13 = C13 +data T14 = C14 +data T15 = C15 +data T16 = C16 +data T17 = C17 +data T18 = C18 +data T19 = C19 +data T20 = C20 +data T21 = C21 +data T22 = C22 +data T23 = C23 +data T24 = C24 +data T25 = C25 +data T26 = C26 +data T27 = C27 +data T28 = C28 +data T29 = C29 +data T30 = C30 +data T31 = C31 +data T32 = C32 +data T33 = C33 +data T34 = C34 +data T35 = C35 +data T36 = C36 +data T37 = C37 +data T38 = C38 +data T39 = C39 +data T40 = C40 +data T41 = C41 +data T42 = C42 +data T43 = C43 +data T44 = C44 +data T45 = C45 +data T46 = C46 +data T47 = C47 +data T48 = C48 +data T49 = C49 +data T50 = C50 +data T51 = C51 +data T52 = C52 +data T53 = C53 +data T54 = C54 +data T55 = C55 +data T56 = C56 +data T57 = C57 +data T58 = C58 +data T59 = C59 +data T60 = C60 +data T61 = C61 +data T62 = C62 +data T63 = C63 +data T64 = C64 +data T65 = C65 +data T66 = C66 +data T67 = C67 +data T68 = C68 +data T69 = C69 +data T70 = C70 + +f :: Arrow a => a Int Int +f = proc x0 -> do + x1 <- returnA -< C1 + x2 <- returnA -< C2 + x3 <- returnA -< C3 + x4 <- returnA -< C4 + x5 <- returnA -< C5 + x6 <- returnA -< C6 + x7 <- returnA -< C7 + x8 <- returnA -< C8 + x9 <- returnA -< C9 + x10 <- returnA -< C10 + x11 <- returnA -< C11 + x12 <- returnA -< C12 + x13 <- returnA -< C13 + x14 <- returnA -< C14 + x15 <- returnA -< C15 + x16 <- returnA -< C16 + x17 <- returnA -< C17 + x18 <- returnA -< C18 + x19 <- returnA -< C19 + x20 <- returnA -< C20 + x21 <- returnA -< C21 + x22 <- returnA -< C22 + x23 <- returnA -< C23 + x24 <- returnA -< C24 + x25 <- returnA -< C25 + x26 <- returnA -< C26 + x27 <- returnA -< C27 + x28 <- returnA -< C28 + x29 <- returnA -< C29 + x30 <- returnA -< C30 + x31 <- returnA -< C31 + x32 <- returnA -< C32 + x33 <- returnA -< C33 + x34 <- returnA -< C34 + x35 <- returnA -< C35 + x36 <- returnA -< C36 + x37 <- returnA -< C37 + x38 <- returnA -< C38 + x39 <- returnA -< C39 + x40 <- returnA -< C40 + x41 <- returnA -< C41 + x42 <- returnA -< C42 + x43 <- returnA -< C43 + x44 <- returnA -< C44 + x45 <- returnA -< C45 + x46 <- returnA -< C46 + x47 <- returnA -< C47 + x48 <- returnA -< C48 + x49 <- returnA -< C49 + x50 <- returnA -< C50 + x51 <- returnA -< C51 + x52 <- returnA -< C52 + x53 <- returnA -< C53 + x54 <- returnA -< C54 + x55 <- returnA -< C55 + x56 <- returnA -< C56 + x57 <- returnA -< C57 + x58 <- returnA -< C58 + x59 <- returnA -< C59 + x60 <- returnA -< C60 + x61 <- returnA -< C61 + x62 <- returnA -< C62 + x63 <- returnA -< C63 + x64 <- returnA -< C64 + x65 <- returnA -< C65 + x66 <- returnA -< C66 + x67 <- returnA -< C67 + x68 <- returnA -< C68 + x69 <- returnA -< C69 + x70 <- returnA -< C70 + returnA -< x70 + returnA -< x69 + returnA -< x68 + returnA -< x67 + returnA -< x66 + returnA -< x65 + returnA -< x64 + returnA -< x63 + returnA -< x62 + returnA -< x61 + returnA -< x60 + returnA -< x59 + returnA -< x58 + returnA -< x57 + returnA -< x56 + returnA -< x55 + returnA -< x54 + returnA -< x53 + returnA -< x52 + returnA -< x51 + returnA -< x50 + returnA -< x49 + returnA -< x48 + returnA -< x47 + returnA -< x46 + returnA -< x45 + returnA -< x44 + returnA -< x43 + returnA -< x42 + returnA -< x41 + returnA -< x40 + returnA -< x39 + returnA -< x38 + returnA -< x37 + returnA -< x36 + returnA -< x35 + returnA -< x34 + returnA -< x33 + returnA -< x32 + returnA -< x31 + returnA -< x30 + returnA -< x29 + returnA -< x28 + returnA -< x27 + returnA -< x26 + returnA -< x25 + returnA -< x24 + returnA -< x23 + returnA -< x22 + returnA -< x21 + returnA -< x20 + returnA -< x19 + returnA -< x18 + returnA -< x17 + returnA -< x16 + returnA -< x15 + returnA -< x14 + returnA -< x13 + returnA -< x12 + returnA -< x11 + returnA -< x10 + returnA -< x9 + returnA -< x8 + returnA -< x7 + returnA -< x6 + returnA -< x5 + returnA -< x4 + returnA -< x3 + returnA -< x2 + returnA -< x1 + returnA -< x0 diff --git a/testsuite/tests/arrows/should_compile/arrowform1.hs b/testsuite/tests/arrows/should_compile/arrowform1.hs new file mode 100644 index 0000000000..a282d71ed7 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowform1.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE Arrows #-} + +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,"")) + +f :: ArrowPlus a => a (Int,Int) String +f = proc (x,y) -> + (|handle + (returnA -< show y) + (\s -> returnA -< s ++ show x) + |) + +g :: ArrowPlus a => a (Int,Int) String +g = proc (x,y) -> + (|handle + (\msg -> returnA -< msg ++ show y) + (\s msg -> returnA -< s ++ show x) + |) ("hello " ++ show x) + +h :: ArrowPlus a => a (Int,Int) Int +h = proc (x,y) -> + ( + (\z -> returnA -< x + z) + <+> + (\z -> returnA -< y + z) + ) (x*y) diff --git a/testsuite/tests/arrows/should_compile/arrowif1.hs b/testsuite/tests/arrows/should_compile/arrowif1.hs new file mode 100644 index 0000000000..404b1f164c --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowif1.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: ArrowChoice a => a (Int,Int,Int) Int +f = proc (x,y,z) -> if x < y then returnA -< x+y else returnA -< x+z + +g :: ArrowChoice a => Int -> a (Int,Int) Int +g x = proc (y,z) -> if x < y then returnA -< x+y else returnA -< x+z diff --git a/testsuite/tests/arrows/should_compile/arrowlet1.hs b/testsuite/tests/arrows/should_compile/arrowlet1.hs new file mode 100644 index 0000000000..b08e030d1c --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowlet1.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow + +f :: Arrow a => a (Int,Int) Int +f = proc (x,y) -> let z = x*y in returnA -< y+z diff --git a/testsuite/tests/arrows/should_compile/arrowpat.hs b/testsuite/tests/arrows/should_compile/arrowpat.hs new file mode 100644 index 0000000000..56b1117e9a --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowpat.hs @@ -0,0 +1,23 @@ +{-# OPTIONS -XArrows #-} + +-- Test for Trac #1662 + +module Arrow where + +import Control.Arrow + +expr' :: Arrow a => a Int Int +expr' = error "urk" + +term :: Arrow a => a () Int +term = error "urk" + +expr1 :: Arrow a => a () Int +expr1 = proc () -> do + x <- term -< () + expr' -< x + +expr2 :: Arrow a => a () Int +expr2 = proc y -> do + x <- term -< y + expr' -< x diff --git a/testsuite/tests/arrows/should_compile/arrowrec1.hs b/testsuite/tests/arrows/should_compile/arrowrec1.hs new file mode 100644 index 0000000000..57b6de783c --- /dev/null +++ b/testsuite/tests/arrows/should_compile/arrowrec1.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE Arrows #-} + +module ShouldCompile where + +import Control.Arrow +import Data.Char + +f :: ArrowLoop a => a Char Int +f = proc x -> do + a <- returnA -< ord x + rec b <- returnA -< ord c - ord x + c <- returnA -< chr a + returnA -< b + ord c diff --git a/testsuite/tests/arrows/should_fail/Makefile b/testsuite/tests/arrows/should_fail/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/arrows/should_fail/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/arrows/should_fail/T2111.hs b/testsuite/tests/arrows/should_fail/T2111.hs new file mode 100644 index 0000000000..eb242cdd6b --- /dev/null +++ b/testsuite/tests/arrows/should_fail/T2111.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -XArrows -XDoRec -XRecursiveDo#-} +-- Test Trac #2111 + +module Foo where + +foo = do { rec { x <- undefined -< x }; undefined -< x } + +bar1 = do { rec { x <- return ('a':x); }; putStrLn (take 20 x) } + +bar2 = mdo { rec { x <- return ('a':x); }; putStrLn (take 20 x) } diff --git a/testsuite/tests/arrows/should_fail/T2111.stderr b/testsuite/tests/arrows/should_fail/T2111.stderr new file mode 100644 index 0000000000..9c6c17fb53 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/T2111.stderr @@ -0,0 +1,13 @@ + +T2111.hs:1:16: + Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead + +T2111.hs:6:23: + The arrow command + undefined -< x + was found where an expression was expected + In a stmt of a 'do' block: x <- undefined -< x + In a stmt of a 'do' block: rec {x <- undefined -< x} + In the expression: + do { rec {x <- undefined -< x}; + undefined -< x } diff --git a/testsuite/tests/arrows/should_fail/T2111.stderr-ghc-7.0 b/testsuite/tests/arrows/should_fail/T2111.stderr-ghc-7.0 new file mode 100644 index 0000000000..79eb1daaee --- /dev/null +++ b/testsuite/tests/arrows/should_fail/T2111.stderr-ghc-7.0 @@ -0,0 +1,10 @@ + +T2111.hs:6:23: + The arrow command + undefined -< x + was found where an expression was expected + In a stmt of a 'do' expression: x <- undefined -< x + In a stmt of a 'do' expression: rec {x <- undefined -< x} + In the expression: + do { rec {x <- undefined -< x}; + undefined -< x } diff --git a/testsuite/tests/arrows/should_fail/all.T b/testsuite/tests/arrows/should_fail/all.T new file mode 100644 index 0000000000..4da90faba3 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/all.T @@ -0,0 +1,7 @@ +setTestOpts(only_compiler_types(['ghc'])) + +test('arrowfail001', normal, compile_fail, ['']) +test('arrowfail002', normal, compile_fail, ['']) +test('arrowfail003', normal, compile_fail, ['']) +test('arrowfail004', normal, compile_fail, ['']) +test('T2111', normal, compile_fail, ['']) diff --git a/testsuite/tests/arrows/should_fail/arrowfail001.hs b/testsuite/tests/arrows/should_fail/arrowfail001.hs new file mode 100644 index 0000000000..e106c214aa --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail001.hs @@ -0,0 +1,21 @@ + +{-# LANGUAGE Arrows, ExistentialQuantification #-} + +-- Crashed GHC 6.4 with a lint error +-- because of the existential + +-- Esa Pulkkinen <esa.pulkkinen@kotiposti.net> +-- Thomas Jäger <ThJaeger@gmail.com> + +module ShouldFail where + +class Foo a where foo :: a -> () +data Bar = forall a. Foo a => Bar a + +get :: Bar -> () +get = proc x -> case x of Bar a -> foo -< a + +-- This should be rejected because the left side of -< (here foo) +-- should be treated as being outside the scope of the proc: it can't +-- refer to the local variables x and a (this is enforced), nor the +-- existentially quantified type variable introduced by unwrapping x. diff --git a/testsuite/tests/arrows/should_fail/arrowfail001.stderr b/testsuite/tests/arrows/should_fail/arrowfail001.stderr new file mode 100644 index 0000000000..91ec965715 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail001.stderr @@ -0,0 +1,9 @@ + +arrowfail001.hs:16:36: + Ambiguous type variable `a' in the constraint: + (Foo a) arising from a use of `foo' + Probable fix: add a type signature that fixes these type variable(s) + In the expression: foo + In the expression: proc x -> case x of { Bar a -> foo -< a } + In an equation for `get': + get = proc x -> case x of { Bar a -> foo -< a } diff --git a/testsuite/tests/arrows/should_fail/arrowfail002.hs b/testsuite/tests/arrows/should_fail/arrowfail002.hs new file mode 100644 index 0000000000..96cc930565 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail002.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE Arrows #-} + +module ShouldFail where + +g :: Int -> Int +g = proc x -> f x -< x+1 + where f = (*) diff --git a/testsuite/tests/arrows/should_fail/arrowfail002.stderr b/testsuite/tests/arrows/should_fail/arrowfail002.stderr new file mode 100644 index 0000000000..c653acc339 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail002.stderr @@ -0,0 +1,2 @@ + +arrowfail002.hs:6:17: Not in scope: `x' diff --git a/testsuite/tests/arrows/should_fail/arrowfail003.hs b/testsuite/tests/arrows/should_fail/arrowfail003.hs new file mode 100644 index 0000000000..2f8cfeeaed --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail003.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE Arrows #-} +-- Arrow commands where an expression is expected + +module ShouldFail where + +import Control.Arrow + +foo = returnA -< [] +bar = (|zeroArrow|) diff --git a/testsuite/tests/arrows/should_fail/arrowfail003.stderr b/testsuite/tests/arrows/should_fail/arrowfail003.stderr new file mode 100644 index 0000000000..39a6b48139 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail003.stderr @@ -0,0 +1,14 @@ + +arrowfail003.hs:8:7: + The arrow command + returnA -< [] + was found where an expression was expected + In the expression: returnA -< [] + In an equation for `foo': foo = returnA -< [] + +arrowfail003.hs:9:7: + The arrow command + (|zeroArrow |) + was found where an expression was expected + In the expression: (|zeroArrow |) + In an equation for `bar': bar = (|zeroArrow |) diff --git a/testsuite/tests/arrows/should_fail/arrowfail004.hs b/testsuite/tests/arrows/should_fail/arrowfail004.hs new file mode 100644 index 0000000000..3e0835a0e4 --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail004.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE Arrows, ExistentialQuantification #-} + +-- Trac #1662 + +module ShouldFail where + +import Control.Arrow + +data T = forall a. T a + +panic :: (Arrow arrow) => arrow T T +panic = proc (T x) -> do returnA -< T x
\ No newline at end of file diff --git a/testsuite/tests/arrows/should_fail/arrowfail004.stderr b/testsuite/tests/arrows/should_fail/arrowfail004.stderr new file mode 100644 index 0000000000..8a20c6bcbb --- /dev/null +++ b/testsuite/tests/arrows/should_fail/arrowfail004.stderr @@ -0,0 +1,7 @@ + +arrowfail004.hs:12:15: + Proc patterns cannot use existential or GADT data constructors + In the pattern: T x + In the expression: proc (T x) -> do { returnA -< T x } + In an equation for `panic': + panic = proc (T x) -> do { returnA -< T x } diff --git a/testsuite/tests/arrows/should_run/Makefile b/testsuite/tests/arrows/should_run/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/arrows/should_run/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/arrows/should_run/T3822.hs b/testsuite/tests/arrows/should_run/T3822.hs new file mode 100644 index 0000000000..93e6dc5797 --- /dev/null +++ b/testsuite/tests/arrows/should_run/T3822.hs @@ -0,0 +1,17 @@ + +{-# LANGUAGE Arrows #-} + +import Control.Arrow +import qualified Control.Category as Cat + +test :: Int -> Int +test = proc x -> do + let neg = x < 0 + case x of + x | neg -> returnA -< 0 -- GHC panics + --x | x < 0 -> returnA -< 0 -- GHC doesn't panic + _ -> returnA -< 10 + +main = do + print $ test (-1) + print $ test 1 diff --git a/testsuite/tests/arrows/should_run/T3822.stdout b/testsuite/tests/arrows/should_run/T3822.stdout new file mode 100644 index 0000000000..25e7f55667 --- /dev/null +++ b/testsuite/tests/arrows/should_run/T3822.stdout @@ -0,0 +1,2 @@ +0 +10 diff --git a/testsuite/tests/arrows/should_run/all.T b/testsuite/tests/arrows/should_run/all.T new file mode 100644 index 0000000000..a9867dd395 --- /dev/null +++ b/testsuite/tests/arrows/should_run/all.T @@ -0,0 +1,8 @@ +setTestOpts(only_compiler_types(['ghc'])) + +test('arrowrun001', normal, compile_and_run, ['']) +test('arrowrun002', skip_if_fast, compile_and_run, ['']) +test('arrowrun003', normal, compile_and_run, ['']) +test('arrowrun004', skip_if_fast, compile_and_run, ['']) +test('T3822', normal, compile_and_run, ['']) + diff --git a/testsuite/tests/arrows/should_run/arrowrun001.hs b/testsuite/tests/arrows/should_run/arrowrun001.hs new file mode 100644 index 0000000000..c686b32546 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun001.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE Arrows #-} + +-- Toy lambda-calculus interpreter from John Hughes's arrows paper (s5) + +module Main(main) where + +import Data.Maybe(fromJust) +import Control.Arrow + +type Id = String +data Val a = Num Int | Bl Bool | Fun (a (Val a) (Val a)) +data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp + +eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a) +eval (Var s) = proc env -> + returnA -< fromJust (lookup s env) +eval (Add e1 e2) = proc env -> do + ~(Num u) <- eval e1 -< env + ~(Num v) <- eval e2 -< env + returnA -< Num (u + v) +eval (If e1 e2 e3) = proc env -> do + ~(Bl b) <- eval e1 -< env + if b then eval e2 -< env + else eval e3 -< env +eval (Lam x e) = proc env -> + returnA -< Fun (proc v -> eval e -< (x,v):env) +eval (App e1 e2) = proc env -> do + ~(Fun f) <- eval e1 -< env + v <- eval e2 -< env + f -<< v + +-- some tests + +i = Lam "x" (Var "x") +k = Lam "x" (Lam "y" (Var "x")) +double = Lam "x" (Add (Var "x") (Var "x")) + +-- if b then k (double x) x else x + x + x + +text_exp = If (Var "b") + (App (App k (App double (Var "x"))) (Var "x")) + (Add (Var "x") (Add (Var "x") (Var "x"))) + +unNum (Num n) = n + +main = do + print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)])) + print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)])) diff --git a/testsuite/tests/arrows/should_run/arrowrun001.stdout b/testsuite/tests/arrows/should_run/arrowrun001.stdout new file mode 100644 index 0000000000..349103a876 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun001.stdout @@ -0,0 +1,2 @@ +10 +15 diff --git a/testsuite/tests/arrows/should_run/arrowrun002.hs b/testsuite/tests/arrows/should_run/arrowrun002.hs new file mode 100644 index 0000000000..16f29806ac --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun002.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE Arrows #-} + +-- Homogeneous (or depth-preserving) functions over perfectly balanced trees. + +module Main where + +import Control.Arrow +import Control.Category +import Data.Complex +import Prelude hiding (id, (.)) + +infixr 4 :&: + +-- Consider the following non-regular type of perfectly balanced trees, +-- or `powertrees' (cf Jayadev Misra's powerlists): + +data Pow a = Zero a | Succ (Pow (Pair a)) + deriving Show + +type Pair a = (a, a) + +-- Here are some example elements: + +tree0 = Zero 1 +tree1 = Succ (Zero (1, 2)) +tree2 = Succ (Succ (Zero ((1, 2), (3, 4)))) +tree3 = Succ (Succ (Succ (Zero (((1, 2), (3, 4)), ((5, 6), (7, 8)))))) + +-- The elements of this type have a string of constructors expressing +-- a depth n as a Peano numeral, enclosing a nested pair tree of 2^n +-- elements. The type definition ensures that all elements of this type +-- are perfectly balanced binary trees of this form. (Such things arise +-- in circuit design, eg Ruby, and descriptions of parallel algorithms.) +-- And the type system will ensure that all legal programs preserve +-- this structural invariant. +-- +-- The only problem is that the type constraint is too restrictive, rejecting +-- many of the standard operations on these trees. Typically you want to +-- split a tree into two subtrees, do some processing on the subtrees and +-- combine the results. But the type system cannot discover that the two +-- results are of the same depth (and thus combinable). We need a type +-- that says a function preserves depth. Here it is: + +data Hom a b = (a -> b) :&: Hom (Pair a) (Pair b) + +-- A homogeneous (or depth-preserving) function is an infinite sequence of +-- functions of type Pair^n a -> Pair^n b, one for each depth n. We can +-- apply a homogeneous function to a powertree by selecting the function +-- for the required depth: + +apply :: Hom a b -> Pow a -> Pow b +apply (f :&: fs) (Zero x) = Zero (f x) +apply (f :&: fs) (Succ t) = Succ (apply fs t) + +-- Having defined apply, we can forget about powertrees and do all our +-- programming with Hom's. Firstly, Hom is an arrow: + +instance Category Hom where + id = id :&: id + (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs) + +instance Arrow Hom where + arr f = f :&: arr (f *** f) + first (f :&: fs) = + first f :&: (arr transpose >>> first fs >>> arr transpose) + +transpose :: ((a,b), (c,d)) -> ((a,c), (b,d)) +transpose ((a,b), (c,d)) = ((a,c), (b,d)) + +-- arr maps f over the leaves of a powertree. + +-- The composition >>> composes sequences of functions pairwise. +-- +-- The *** operator unriffles a powertree of pairs into a pair of powertrees, +-- applies the appropriate function to each and riffles the results. +-- It defines a categorical product for this arrow category. + +-- When describing algorithms, one often provides a pure function for the +-- base case (trees of one element) and a (usually recursive) expression +-- for trees of pairs. + +-- For example, a common divide-and-conquer pattern is the butterfly, where +-- one recursive call processes the odd-numbered elements and the other +-- processes the even ones (cf Geraint Jones and Mary Sheeran's Ruby papers): + +butterfly :: (Pair a -> Pair a) -> Hom a a +butterfly f = id :&: proc (x, y) -> do + x' <- butterfly f -< x + y' <- butterfly f -< y + returnA -< f (x', y') + +-- The recursive calls operate on halves of the original tree, so the +-- recursion is well-defined. + +-- Some examples of butterflies: + +rev :: Hom a a +rev = butterfly swap + where swap (x, y) = (y, x) + +unriffle :: Hom (Pair a) (Pair a) +unriffle = butterfly transpose + +-- Batcher's sorter for bitonic sequences: + +bisort :: Ord a => Hom a a +bisort = butterfly cmp + where cmp (x, y) = (min x y, max x y) + +-- This can be used (with rev) as the merge phase of a merge sort. +-- +sort :: Ord a => Hom a a +sort = id :&: proc (x, y) -> do + x' <- sort -< x + y' <- sort -< y + yr <- rev -< y' + p <- unriffle -< (x', yr) + bisort2 -< p + where _ :&: bisort2 = bisort + +-- Here is the scan operation, using the algorithm of Ladner and Fischer: + +scan :: (a -> a -> a) -> a -> Hom a a +scan op b = id :&: proc (x, y) -> do + y' <- scan op b -< op x y + l <- rsh b -< y' + returnA -< (op l x, y') + +-- The auxiliary function rsh b shifts each element in the tree one place to +-- the right, placing b in the now-vacant leftmost position, and discarding +-- the old rightmost element: + +rsh :: a -> Hom a a +rsh b = const b :&: proc (x, y) -> do + w <- rsh b -< y + returnA -< (w, x) + +-- Finally, here is the Fast Fourier Transform: + +type C = Complex Double + +fft :: Hom C C +fft = id :&: proc (x, y) -> do + x' <- fft -< x + y' <- fft -< y + r <- roots (-1) -< () + let z = r*y' + unriffle -< (x' + z, x' - z) + +-- The auxiliary function roots r (where r is typically a root of unity) +-- populates a tree of size n (necessarily a power of 2) with the values +-- 1, w, w^2, ..., w^(n-1), where w^n = r. + +roots :: C -> Hom () C +roots r = const 1 :&: proc _ -> do + x <- roots r' -< () + unriffle -< (x, x*r') + where r' = if imagPart s >= 0 then -s else s + s = sqrt r + +-- Miscellaneous functions: + +rrot :: Hom a a +rrot = id :&: proc (x, y) -> do + w <- rrot -< y + returnA -< (w, x) + +ilv :: Hom a a -> Hom (Pair a) (Pair a) +ilv f = proc (x, y) -> do + x' <- f -< x + y' <- f -< y + returnA -< (x', y') + +scan' :: (a -> a -> a) -> a -> Hom a a +scan' op b = proc x -> do + l <- rsh b -< x + (id :&: ilv (scan' op b)) -< op l x + +riffle :: Hom (Pair a) (Pair a) +riffle = id :&: proc ((x1, y1), (x2, y2)) -> do + x <- riffle -< (x1, x2) + y <- riffle -< (y1, y2) + returnA -< (x, y) + +invert :: Hom a a +invert = id :&: proc (x, y) -> do + x' <- invert -< x + y' <- invert -< y + unriffle -< (x', y') + +carryLookaheadAdder :: Hom (Bool, Bool) Bool +carryLookaheadAdder = proc (x, y) -> do + carryOut <- rsh (Just False) -< + if x == y then Just x else Nothing + Just carryIn <- scan plusMaybe Nothing -< carryOut + returnA -< x `xor` y `xor` carryIn + where plusMaybe x Nothing = x + plusMaybe x (Just y) = Just y + False `xor` b = b + True `xor` b = not b + +-- Global conditional for SIMD + +ifAll :: Hom a b -> Hom a b -> Hom (a, Bool) b +ifAll fs gs = ifAllAux snd (arr fst >>> fs) (arr fst >>> gs) + where ifAllAux :: (a -> Bool) -> Hom a b -> Hom a b -> Hom a b + ifAllAux p (f :&: fs) (g :&: gs) = + liftIf p f g :&: ifAllAux (liftAnd p) fs gs + liftIf p f g x = if p x then f x else g x + liftAnd p (x, y) = p x && p y + +maybeAll :: Hom a c -> Hom (a, b) c -> Hom (a, Maybe b) c +maybeAll (n :&: ns) (j :&: js) = + choose :&: (arr dist >>> maybeAll ns (arr transpose >>> js)) + where choose (a, Nothing) = n a + choose (a, Just b) = j (a, b) + dist ((a1, b1), (a2, b2)) = ((a1, a2), zipMaybe b1 b2) + zipMaybe (Just x) (Just y) = Just (x, y) + zipMaybe _ _ = Nothing + +main = do + print (apply rev tree3) + print (apply invert tree3) + print (apply (invert >>> sort) tree3) + print (apply (scan (+) 0) tree3) diff --git a/testsuite/tests/arrows/should_run/arrowrun002.stdout b/testsuite/tests/arrows/should_run/arrowrun002.stdout new file mode 100644 index 0000000000..b13ce3b37a --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun002.stdout @@ -0,0 +1,4 @@ +Succ (Succ (Succ (Zero (((8,7),(6,5)),((4,3),(2,1)))))) +Succ (Succ (Succ (Zero (((1,5),(3,7)),((2,6),(4,8)))))) +Succ (Succ (Succ (Zero (((1,2),(3,4)),((5,6),(7,8)))))) +Succ (Succ (Succ (Zero (((1,3),(6,10)),((15,21),(28,36)))))) diff --git a/testsuite/tests/arrows/should_run/arrowrun003.hs b/testsuite/tests/arrows/should_run/arrowrun003.hs new file mode 100644 index 0000000000..5f4580ab87 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun003.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE Arrows #-} + +module Main(main) where + +import Control.Arrow +import Control.Category +import Prelude hiding (id, (.)) + +class ArrowLoop a => ArrowCircuit a where + delay :: b -> a b b + +-- stream map instance + +data Stream a = Cons a (Stream a) + +instance Functor Stream where + fmap f ~(Cons a as) = Cons (f a) (fmap f as) + +zipStream :: Stream a -> Stream b -> Stream (a,b) +zipStream ~(Cons a as) ~(Cons b bs) = Cons (a,b) (zipStream as bs) + +unzipStream :: Stream (a,b) -> (Stream a, Stream b) +unzipStream abs = (fmap fst abs, fmap snd abs) + +newtype StreamMap a b = StreamMap (Stream a -> Stream b) +unStreamMap (StreamMap f) = f + +instance Category StreamMap where + id = StreamMap id + StreamMap f . StreamMap g = StreamMap (f . g) + +instance Arrow StreamMap where + arr f = StreamMap (fmap f) + first (StreamMap f) = + StreamMap (uncurry zipStream . first f . unzipStream) + +instance ArrowLoop StreamMap where + loop (StreamMap f) = + StreamMap (loop (unzipStream . f . uncurry zipStream)) + +instance ArrowCircuit StreamMap where + delay a = StreamMap (Cons a) + +listToStream :: [a] -> Stream a +listToStream = foldr Cons undefined + +streamToList :: Stream a -> [a] +streamToList (Cons a as) = a:streamToList as + +runStreamMap :: StreamMap a b -> [a] -> [b] +runStreamMap (StreamMap f) as = + take (length as) (streamToList (f (listToStream as))) + +-- simple automaton instance + +data Auto a b = Auto (a -> (b, Auto a b)) + +instance Category Auto where + id = Auto $ \a -> (a, id) + Auto f . Auto g = Auto $ \b -> + let (c, g') = g b + (d, f') = f c + in (d, f' . g') + +instance Arrow Auto where + arr f = Auto $ \a -> (f a, arr f) + first (Auto f) = Auto $ \(b,d) -> let (c,f') = f b in ((c,d), first f') + +instance ArrowLoop Auto where + loop (Auto f) = Auto $ \b -> + let (~(c,d), f') = f (b,d) + in (c, loop f') + +instance ArrowCircuit Auto where + delay a = Auto $ \a' -> (a, delay a') + +runAuto :: Auto a b -> [a] -> [b] +runAuto (Auto f) [] = [] +runAuto (Auto f) (a:as) = let (b, f') = f a in b:runAuto f' as + +-- Some simple example circuits + +-- A resettable counter (first example in several Hawk papers): + +counter :: ArrowCircuit a => a Bool Int +counter = proc reset -> do + rec output <- returnA -< if reset then 0 else next + next <- delay 0 -< output+1 + returnA -< output + +-- Some other basic circuits from the Hawk library. + +-- flush: when reset is True, return d for n ticks, otherwise copy value. +-- (a variation on the resettable counter) + +flush :: ArrowCircuit a => Int -> b -> a (b, Bool) b +flush n d = proc (value, reset) -> do + rec count <- returnA -< if reset then n else max (next-1) 0 + next <- delay 0 -< count + returnA -< if count > 0 then d else value + +-- latch: on each tick, return the last value for which reset was True, +-- or init if there was none. +-- +latch :: ArrowCircuit a => b -> a (b, Bool) b +latch init = proc (value, reset) -> do + rec out <- returnA -< if reset then value else last + last <- delay init -< out + returnA -< out + +-- Some tests using the counter + +test_input = [True, False, True, False, False, True, False, True] +test_input2 = zip [1..] test_input + +-- A test of the resettable counter. + +main = do + print (runStreamMap counter test_input) + print (runAuto counter test_input) + print (runStreamMap (flush 2 0) test_input2) + print (runAuto (flush 2 0) test_input2) + print (runStreamMap (latch 0) test_input2) + print (runAuto (latch 0) test_input2) + +-- A step function (cf current in Lustre) + +step :: ArrowCircuit a => b -> a (Either b c) b +step b = proc x -> do + rec last_b <- delay b -< getLeft last_b x + returnA -< last_b + where getLeft _ (Left b) = b + getLeft b (Right _) = b diff --git a/testsuite/tests/arrows/should_run/arrowrun003.stdout b/testsuite/tests/arrows/should_run/arrowrun003.stdout new file mode 100644 index 0000000000..21a7156d60 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun003.stdout @@ -0,0 +1,6 @@ +[0,1,0,1,2,0,1,0] +[0,1,0,1,2,0,1,0] +[0,0,0,0,5,0,0,0] +[0,0,0,0,5,0,0,0] +[1,1,3,3,3,6,6,8] +[1,1,3,3,3,6,6,8] diff --git a/testsuite/tests/arrows/should_run/arrowrun004.hs b/testsuite/tests/arrows/should_run/arrowrun004.hs new file mode 100644 index 0000000000..c0275065f2 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun004.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances #-} + +-- Simple expression parser +-- (uses do-notation and operators) + +module Main(main) where + +import Control.Arrow +import Control.Category +import Data.Char +import Prelude hiding (id, (.)) + +-- Parsers + +class (Eq s, Show s, ArrowPlus a) => ArrowParser s a where + symbol :: s -> a b String + +data Sym s = Sym { token :: s, value :: String } + +-- Simple backtracking instance + +newtype BTParser s a b = BTParser (a -> [Sym s] -> [(b, [Sym s])]) + +instance Category (BTParser s) where + id = BTParser $ \a ss -> [(a, ss)] + BTParser f . BTParser g = BTParser $ \b ss -> + [(d, ss'') | (c, ss') <- g b ss, (d, ss'') <- f c ss'] + +instance Arrow (BTParser s) where + arr f = BTParser $ \a ss -> [(f a, ss)] + first (BTParser f) = BTParser $ \(b,d) ss -> + [((c,d), ss') | (c,ss') <- f b ss] + +instance ArrowZero (BTParser s) where + zeroArrow = BTParser $ \b ss -> [] + +instance ArrowPlus (BTParser s) where + BTParser f <+> BTParser g = BTParser $ \b ss -> f b ss ++ g b ss + +instance (Eq s, Show s) => ArrowParser s (BTParser s) where + symbol s = BTParser $ \b ss -> + case ss of + Sym s' v:ss' | s' == s -> [(v, ss')] + _ -> [] + +runBTParser :: BTParser s () c -> [Sym s] -> c +runBTParser (BTParser parser) syms = + head [c | (c, []) <- parser () syms] + +-- Expressions + +data ESym = LPar | RPar | Plus | Minus | Mult | Div | Number | Unknown + deriving (Show, Eq, Ord) + +type ExprParser = BTParser ESym +type ExprSym = Sym ESym + +-- The grammar + +expr :: ExprParser () Int +expr = proc () -> do + x <- term -< () + expr' -< x + +expr' :: ExprParser Int Int +expr' = proc x -> do + returnA -< x + <+> do + (|(symbol Plus)|) + y <- term -< () + expr' -< x + y + <+> do + (|(symbol Minus)|) + y <- term -< () + expr' -< x - y + +term :: ExprParser () Int +term = proc () -> do + x <- factor -< () + term' -< x + +term' :: ExprParser Int Int +term' = proc x -> do + returnA -< x + <+> do + (|(symbol Mult)|) + y <- factor -< () + term' -< x * y + <+> do + (|(symbol Div)|) + y <- factor -< () + term' -< x `div` y + +factor :: ExprParser () Int +factor = proc () -> do + v <- (|(symbol Number)|) + returnA -< read v::Int + <+> do + (|(symbol Minus)|) + v <- factor -< () + returnA -< -v + <+> do + (|(symbol LPar)|) + v <- expr -< () + (|(symbol RPar)|) + returnA -< v + +-- Lexical analysis + +lexer :: String -> [ExprSym] +lexer [] = [] +lexer ('(':cs) = Sym LPar "(":lexer cs +lexer (')':cs) = Sym RPar ")":lexer cs +lexer ('+':cs) = Sym Plus "+":lexer cs +lexer ('-':cs) = Sym Minus "-":lexer cs +lexer ('*':cs) = Sym Mult "*":lexer cs +lexer ('/':cs) = Sym Div "/":lexer cs +lexer (c:cs) + | isSpace c = lexer cs + | isDigit c = Sym Number (c:w):lexer cs' + | otherwise = Sym Unknown [c]:lexer cs + where (w,cs') = span isDigit cs + +parse = runBTParser expr . lexer + +main = do + print (parse "1+2*(3+4)") + print (parse "3*5-17/3+4") diff --git a/testsuite/tests/arrows/should_run/arrowrun004.stdout b/testsuite/tests/arrows/should_run/arrowrun004.stdout new file mode 100644 index 0000000000..cbb71fdd82 --- /dev/null +++ b/testsuite/tests/arrows/should_run/arrowrun004.stdout @@ -0,0 +1,2 @@ +15 +14 |