diff options
| author | Alexis King <lexi.lambda@gmail.com> | 2020-04-19 20:11:37 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-30 01:57:35 -0400 |
| commit | a48cd2a045695c5f34ed7b00184a8d91c4fcac0e (patch) | |
| tree | 526d1b2e19ce1b8ffcaeb73688999a255de2ef2e /testsuite/tests | |
| parent | 71484b09fa3c676e99785b3d68f69d4cfb14266e (diff) | |
| download | haskell-a48cd2a045695c5f34ed7b00184a8d91c4fcac0e.tar.gz | |
Allow LambdaCase to be used as a command in proc notation
Diffstat (limited to 'testsuite/tests')
5 files changed, 31 insertions, 1 deletions
diff --git a/testsuite/tests/arrows/should_run/ArrowLambdaCase.hs b/testsuite/tests/arrows/should_run/ArrowLambdaCase.hs new file mode 100644 index 0000000000..c678339890 --- /dev/null +++ b/testsuite/tests/arrows/should_run/ArrowLambdaCase.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE Arrows, LambdaCase #-} +module Main (main) where + +import Control.Arrow + +main :: IO () +main = do + putStrLn $ foo (Just 42) + putStrLn $ foo (Just 500) + putStrLn $ foo Nothing + +foo :: ArrowChoice p => p (Maybe Int) String +foo = proc x -> + (| id (\case + Just x | x > 100 -> returnA -< "big " ++ show x + | otherwise -> returnA -< "small " ++ show x + Nothing -> returnA -< "none") + |) x diff --git a/testsuite/tests/arrows/should_run/ArrowLambdaCase.stdout b/testsuite/tests/arrows/should_run/ArrowLambdaCase.stdout new file mode 100644 index 0000000000..09e50cf6d7 --- /dev/null +++ b/testsuite/tests/arrows/should_run/ArrowLambdaCase.stdout @@ -0,0 +1,3 @@ +small 42 +big 500 +none diff --git a/testsuite/tests/arrows/should_run/all.T b/testsuite/tests/arrows/should_run/all.T index 2faabff765..0a1e32e34c 100644 --- a/testsuite/tests/arrows/should_run/all.T +++ b/testsuite/tests/arrows/should_run/all.T @@ -3,4 +3,4 @@ test('arrowrun002', when(fast(), skip), compile_and_run, ['']) test('arrowrun003', normal, compile_and_run, ['']) test('arrowrun004', when(fast(), skip), compile_and_run, ['']) test('T3822', normal, compile_and_run, ['']) - +test('ArrowLambdaCase', normal, compile_and_run, ['']) diff --git a/testsuite/tests/parser/should_compile/ParserArrowLambdaCase.hs b/testsuite/tests/parser/should_compile/ParserArrowLambdaCase.hs new file mode 100644 index 0000000000..b16eb7579b --- /dev/null +++ b/testsuite/tests/parser/should_compile/ParserArrowLambdaCase.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Arrows, LambdaCase #-} +module ParserArrowLambdaCase where + +import Control.Arrow + +foo :: () -> () +foo = proc () -> (| id (\case + () -> () >- returnA) |) () diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index fd69d32f0f..1568a341ec 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -94,6 +94,7 @@ test('mc15', normal, compile, ['']) test('mc16', normal, compile, ['']) test('EmptyDecls', normal, compile, ['']) test('ParserLambdaCase', [], compile, ['']) +test('ParserArrowLambdaCase', [], compile, ['']) test('ColumnPragma', normal, compile, ['']) test('T5243', [], multimod_compile, ['T5243', '']) |