Trigger multiline mode in GHCi on '\case' (#13087)
authorAlec Theriault <alec.theriault@gmail.com>
Wed, 24 Oct 2018 11:02:08 +0000 (07:02 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Wed, 24 Oct 2018 11:02:08 +0000 (07:02 -0400)
Summary:
In ALR, 'ITlcase' should expect an opening curly. This is probably a forgotten
edge case in ALR, since `maybe_layout` (which handles the non-ALR layout)
already deals with the 'ITlcase' token properly.

Test Plan: make TEST=T10453 && make TEST=T13087

Reviewers: bgamari, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, carter

GHC Trac Issues: #10453, #13087

Differential Revision: https://phabricator.haskell.org/D5236

compiler/parser/Lexer.x
testsuite/tests/ghci/scripts/T10453.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T10453.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T
testsuite/tests/parser/should_compile/T13087.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/all.T

index f820007..f99a344 100644 (file)
@@ -2673,6 +2673,7 @@ lexTokenAlr = do mPending <- popPendingImplicitToken
                      ITwhere -> setAlrExpectingOCurly (Just ALRLayoutWhere)
                      ITlet   -> setAlrExpectingOCurly (Just ALRLayoutLet)
                      ITof    -> setAlrExpectingOCurly (Just ALRLayoutOf)
+                     ITlcase -> setAlrExpectingOCurly (Just ALRLayoutOf)
                      ITdo    -> setAlrExpectingOCurly (Just ALRLayoutDo)
                      ITmdo   -> setAlrExpectingOCurly (Just ALRLayoutDo)
                      ITrec   -> setAlrExpectingOCurly (Just ALRLayoutDo)
diff --git a/testsuite/tests/ghci/scripts/T10453.script b/testsuite/tests/ghci/scripts/T10453.script
new file mode 100644 (file)
index 0000000..7ab916a
--- /dev/null
@@ -0,0 +1,16 @@
+:set +m
+:set -XLambdaCase
+
+foo1 x = case x of
+           1 -> "one"
+           _ -> "not one"
+
+foo1 0
+foo1 1
+
+foo2 = \case
+          1 -> "one"
+          _ -> "not one"
+
+foo2 0
+foo2 1
diff --git a/testsuite/tests/ghci/scripts/T10453.stdout b/testsuite/tests/ghci/scripts/T10453.stdout
new file mode 100644 (file)
index 0000000..55be53d
--- /dev/null
@@ -0,0 +1,4 @@
+"not one"
+"one"
+"not one"
+"one"
index 67c4b38..bb3be80 100755 (executable)
@@ -224,6 +224,7 @@ test('T10248', normal, ghci_script, ['T10248.script'])
 test('T10110', normal, ghci_script, ['T10110.script'])
 test('T10322', normal, ghci_script, ['T10322.script'])
 test('T10439', normal, ghci_script, ['T10439.script'])
+test('T10453', normal, ghci_script, ['T10453.script'])
 test('T10466', normal, ghci_script, ['T10466.script'])
 test('T10501', normal, ghci_script, ['T10501.script'])
 test('T10508', normal, ghci_script, ['T10508.script'])
diff --git a/testsuite/tests/parser/should_compile/T13087.hs b/testsuite/tests/parser/should_compile/T13087.hs
new file mode 100644 (file)
index 0000000..8e83028
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE AlternativeLayoutRule #-}
+{-# LANGUAGE LambdaCase            #-}
+
+isOne :: Int -> Bool
+isOne = \case 1 -> True
+              _ -> False
+
+main = return ()
index 842bef0..7b1142c 100644 (file)
@@ -113,6 +113,7 @@ test('T11622', normal, compile, [''])
 test('DumpParsedAst',      normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
 test('DumpRenamedAst',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
 test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
+test('T13087', normal, compile, [''])
 test('T13747', normal, compile, [''])
 test('T14189',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
 test('T13986', normal, compile, [''])