diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2022-05-27 01:40:10 +0200 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2022-06-15 17:10:35 +0100 |
| commit | c1b46818b244dac7cfd147fb587aa0e557590a94 (patch) | |
| tree | f4b9184456cbe2fd0460f95761ff323cc6326173 /testsuite | |
| parent | 8504e24e00b0d6403adcf75c4c60e12dd6d85f1b (diff) | |
| download | haskell-c1b46818b244dac7cfd147fb587aa0e557590a94.tar.gz | |
Fix FreeVars computation for mdo
Commit acb188e0 introduced a regression in the computation of free
variables in mdo statements, as the logic in
GHC.Rename.Expr.segmentRecStmts was slightly different depending on
whether the recursive do block corresponded to an mdo statement or
a rec statment.
This patch restores the previous computation for mdo blocks.
Fixes #21654
(cherry picked from commit b54f6c4fefaca8ca043cccbf474fb0da3d1c66b5)
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/tests/rename/should_compile/T21654.hs | 17 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/all.T | 1 |
2 files changed, 18 insertions, 0 deletions
diff --git a/testsuite/tests/rename/should_compile/T21654.hs b/testsuite/tests/rename/should_compile/T21654.hs new file mode 100644 index 0000000000..12b0c763f6 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T21654.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE RecursiveDo #-} +{-# OPTIONS_GHC -Wunused-top-binds #-} + +module T21654 ( patternToQ ) where + +import Data.Functor.Identity + +mergeNullViews :: () -> () +mergeNullViews _ = () + +patternToQ :: () +patternToQ = runIdentity $ combineSeq + where + combineSeq :: Identity () + combineSeq = mdo -- changing this to 'do' fixes the problem + q <- Identity () + return $ mergeNullViews q diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index e81bc0e4c8..ac660606ab 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -188,3 +188,4 @@ test('T20609d', normal, compile, ['']) test('T18862', normal, compile, ['']) test('unused_haddock', normal, compile, ['-haddock -Wall']) test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors']) +test('T21654', normal, compile, ['-Wunused-top-binds']) |