hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

CaseSplit panic sorted. closes https://github.com/kazu-yamamoto/ghc-mod/issues/336

This commit is contained in:
Alan Zimmerman 2014-08-23 14:06:26 +02:00
parent 9101f306d1
commit 0944820dba
3 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -69,10 +69,10 @@ getSrcSpanTypeForSplit modSum lineNo colNo = do
-- Information for a function case split -- Information for a function case split
getSrcSpanTypeForFnSplit :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe SplitInfo) getSrcSpanTypeForFnSplit :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe SplitInfo)
getSrcSpanTypeForFnSplit modSum lineNo colNo = do getSrcSpanTypeForFnSplit modSum lineNo colNo = do
p@ParsedModule{pm_parsed_source = pms} <- G.parseModule modSum p@ParsedModule{pm_parsed_source = _pms} <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
let varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id) let varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id)
match:_ = listifyParsedSpans pms (lineNo, colNo) :: [Gap.GLMatch] match:_ = listifySpans tcs (lineNo, colNo) :: [Gap.GLMatchI]
case varPat of case varPat of
Nothing -> return Nothing Nothing -> return Nothing
Just varPat' -> do Just varPat' -> do

3
Language/Haskell/GhcMod/Gap.hs
View File

@ -37,6 +37,7 @@ module Language.Haskell.GhcMod.Gap (
, benchmarkTargets , benchmarkTargets
, toModuleString , toModuleString
, GLMatch , GLMatch
, GLMatchI
, getClass , getClass
, occName , occName
, setFlags , setFlags
@ -437,8 +438,10 @@ toModuleString mn = fromFilePath $ M.toFilePath mn
#if __GLASGOW_HASKELL__ >= 708 #if __GLASGOW_HASKELL__ >= 708
type GLMatch = LMatch RdrName (LHsExpr RdrName) type GLMatch = LMatch RdrName (LHsExpr RdrName)
type GLMatchI = LMatch Id (LHsExpr Id)
#else #else
type GLMatch = LMatch RdrName type GLMatch = LMatch RdrName
type GLMatchI = LMatch Id
#endif #endif
getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan) getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)

19
test/CaseSplitSpec.hs
View File

@ -1,25 +1,20 @@
{-# LANGUAGE CPP #-}
module CaseSplitSpec where module CaseSplitSpec where
import Control.Applicative ((<$>))
import Data.List (isPrefixOf)
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
#if __GLASGOW_HASKELL__ < 706
import System.Environment.Executable (getExecutablePath)
#else
import System.Environment (getExecutablePath)
#endif
import System.Exit
import System.FilePath
import System.Process
import Test.Hspec import Test.Hspec
import TestUtils import TestUtils
import Dir import Dir
main :: IO ()
main = do
hspec spec
spec :: Spec spec :: Spec
spec = do spec = do
describe "case split" $ do describe "case split" $ do
it "does not blow up on HsWithBndrs panic" $ do it "does not blow up on HsWithBndrs panic" $ do
withDirectory_ "test/data/case-split" $ do withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect.hs" 24 10 res <- runD $ splits "Vect.hs" 24 10
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" res `shouldBe` "24 1 24 30"++
" \"mlAppend Nil y = _mlAppend_body\NUL"++
"mlAppend (Cons x1 x2) y = _mlAppend_body\"\n"