grin-compiler/grin
1
1
Fork 0
mirror of https://github.com/grin-compiler/grin.git synced 2024-10-27 01:02:12 +03:00
Code Issues Projects Releases Wiki Activity

Test: Remove invalid contexts.

Browse Source
This commit is contained in:
Andor Penzes 2018-03-20 22:25:43 +01:00
parent 51aaced70a
commit 6f09e60743
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
grin/src/Test.hs
View File

@ -58,8 +58,6 @@ testExprContextE mkSpec =
contexts :: [TestExpContext]
contexts =
[ emptyCtx
, firstBindR
, middleBindR
, lastBindR
, bindL
, lastBindL
@ -68,9 +66,9 @@ contexts =
, lastAlt
]
contexts_ :: [TestExpContext]
contexts_ =
[ bindL
contexts1 :: [TestExpContext]
contexts1 =
[ middleBindR
]
emptyCtx :: TestExpContext
@ -78,13 +76,22 @@ emptyCtx = ("empty", id)
exprText = pack . show . PP
firstBindR :: TestExpContext
firstBindR = ("first bind right", second tr) where
firstBindR1 :: TestExpContext
firstBindR1 = ("first bind right", second tr) where
tr (exprText -> e) = [expr|
$e
pure ()
|]
changeLast :: Exp -> Exp -> Exp
changeLast e (EBind l p r) = EBind l p (changeLast e r)
changeLast e r@(ECase{}) = EBind (SBlock r) (Var "cl") e
changeLast e r = EBind r (Var "cl") e
firstBindR :: TestExpContext
firstBindR = ("first bind right", second tr) where
tr e = changeLast (SReturn (Lit (LInt64 1))) e
middleBindR :: TestExpContext
middleBindR = ("middle bind right", second tr) where
tr (exprText -> e) = [expr|
@ -100,6 +107,7 @@ lastBindR = ("last bind right", second tr) where
$e
|]
bindL :: TestExpContext
bindL = ("bind left", second tr) where
tr (exprText -> e) = [expr|