Fix case-split spec for 706

This commit is contained in:
Nikolay Yakimov 2016-07-10 17:43:08 +03:00
parent 0e788e295c
commit 1a302707b3
2 changed files with 69 additions and 0 deletions

View File

@ -13,6 +13,7 @@ main = do
spec :: Spec
spec = do
describe "case split" $ do
#if __GLASGOW_HASKELL__ >= 708
it "does not blow up on HsWithBndrs panic" $ do
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect.hs" 24 10
@ -40,7 +41,36 @@ spec = do
res `shouldBe` "38 21 38 59"++
" \"mlReverse' Nil accum = _mlReverse_body\NUL"++
" mlReverse' (Cons xs'1 xs'2) accum = _mlReverse_body\"\n"
#else
it "does not blow up on HsWithBndrs panic" $ do
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect706.hs" 24 10
res `shouldBe` "24 1 24 25"++
" \"mlAppend Nil y = undefined\NUL"++
"mlAppend (Cons x1 x2) y = undefined\"\n"
it "works with case expressions" $ do
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect706.hs" 28 20
res `shouldBe` "28 19 28 34"++
" \"Nil -> undefined\NUL"++
" (Cons x'1 x'2) -> undefined\"\n"
it "works with where clauses" $ do
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect706.hs" 34 17
res `shouldBe` "34 5 34 37"++
" \"mlReverse' Nil accum = undefined\NUL"++
" mlReverse' (Cons xs'1 xs'2) accum = undefined\"\n"
it "works with let bindings" $ do
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Vect706.hs" 38 33
res `shouldBe` "38 21 38 53"++
" \"mlReverse' Nil accum = undefined\NUL"++
" mlReverse' (Cons xs'1 xs'2) accum = undefined\"\n"
#endif
it "doesn't crash when source doesn't make sense" $
withDirectory_ "test/data/case-split" $ do
res <- runD $ splits "Crash.hs" 4 6

View File

@ -0,0 +1,39 @@
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, GADTs, KindSignatures #-}
module Vect706 where
data Nat = Z | S Nat
type family (n :: Nat) :+ (m :: Nat) :: Nat
type instance Z :+ m = m
type instance S n :+ m = S (n :+ m)
data Vect :: Nat -> * -> * where
VNil :: Vect Z a
(:::) :: a -> Vect n a -> Vect (S n) a
vAppend :: Vect n a -> Vect m a -> Vect (n :+ m) a
vAppend x y = undefined
lAppend :: [a] -> [a] -> [a]
lAppend x y = undefined
data MyList a = Nil | Cons a (MyList a)
mlAppend :: MyList a -> MyList a -> MyList a
mlAppend x y = undefined
mlAppend2 :: MyList a -> MyList a -> MyList a
mlAppend2 x y = case x of
x' -> undefined
mlReverse :: MyList a -> MyList a
mlReverse xs = mlReverse' xs Nil
where
mlReverse' :: MyList a -> MyList a -> MyList a
mlReverse' xs' accum = undefined
mlReverse2 :: MyList a -> MyList a
mlReverse2 xs = let mlReverse' :: MyList a -> MyList a -> MyList a
mlReverse' xs' accum = undefined
in mlReverse' xs Nil