diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-05-13 22:48:03 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-05-13 22:48:17 +0200 |
commit | 8f2e602cada9141b653802cf1084b9bdfd6e0d06 (patch) | |
tree | c1351e9fcb0341af482f8da4a8859e2046445188 /test/runTests.hs | |
parent | 8ac42fa1bccb554de833ea7d8070cb5112e01aee (diff) |
refactoring & fix build
Diffstat (limited to 'test/runTests.hs')
-rw-r--r-- | test/runTests.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/test/runTests.hs b/test/runTests.hs index 14d8f5ca..228858ce 100644 --- a/test/runTests.hs +++ b/test/runTests.hs | |||
@@ -219,9 +219,9 @@ doTest Config{..} (i, fn) = do | |||
219 | 219 | ||
220 | getMain = do | 220 | getMain = do |
221 | res <- local (const $ ioFetch [pa]) $ loadModule id Nothing (Left $ mn' ++ concat exts ++ ".lc") <&> \case | 221 | res <- local (const $ ioFetch [pa]) $ loadModule id Nothing (Left $ mn' ++ concat exts ++ ".lc") <&> \case |
222 | Left err -> (mempty, Left err) | 222 | Left err -> (mempty, Left (Nothing, err)) |
223 | Right (fname, (src, Left err)) -> (mempty, Left err) | 223 | Right (fname, (src, Left err)) -> (mempty, Left (Just fname, err)) |
224 | Right (fname, (src, Right (pm, infos, Left err))) -> (,) infos $ Left err | 224 | Right (fname, (src, Right (pm, infos, Left err))) -> (,) infos $ Left (Just fname, err) |
225 | Right (fname, (src, Right (pm, infos, Right (_, ge)))) -> (,) infos $ Right | 225 | Right (fname, (src, Right (pm, infos, Right (_, ge)))) -> (,) infos $ Right |
226 | ( fname | 226 | ( fname |
227 | , ge | 227 | , ge |
@@ -237,7 +237,7 @@ doTest Config{..} (i, fn) = do | |||
237 | --getDef :: MonadMask m => FilePath -> SName -> Maybe Exp -> MMT m (Infos, [Stmt]) ((Infos, [Stmt]), Either Doc (FilePath, Either Doc ExpType)) | 237 | --getDef :: MonadMask m => FilePath -> SName -> Maybe Exp -> MMT m (Infos, [Stmt]) ((Infos, [Stmt]), Either Doc (FilePath, Either Doc ExpType)) |
238 | 238 | ||
239 | f ((i, desug), e) | not $ isReject fn = case e of | 239 | f ((i, desug), e) | not $ isReject fn = case e of |
240 | Left (show -> e) -> Left (unlines $ tab "!Failed" e: map show (listTraceInfos i), Failed) | 240 | Left (_, show -> e) -> Left (unlines $ tab "!Failed" e: map show (listTraceInfos i), Failed) |
241 | Right (fname, ge, Left (pShow -> e)) | 241 | Right (fname, ge, Left (pShow -> e)) |
242 | -> Right ("typechecked module", simpleShow $ vcat $ e: showGE fname ge) | 242 | -> Right ("typechecked module", simpleShow $ vcat $ e: showGE fname ge) |
243 | Right (fname, ge, Right (ET e te)) | 243 | Right (fname, ge, Right (ET e te)) |
@@ -249,15 +249,15 @@ doTest Config{..} (i, fn) = do | |||
249 | de = simpleShow $ vcat $ (DAnn "main" $ pShow te) : (DLet "=" "main" res): showGE fname ge | 249 | de = simpleShow $ vcat $ (DAnn "main" $ pShow te) : (DLet "=" "main" res): showGE fname ge |
250 | res = mkDoc (True, False) e | 250 | res = mkDoc (True, False) e |
251 | | otherwise = case e of | 251 | | otherwise = case e of |
252 | Left (pShow -> e) -> Right ("error message", simpleShow $ vcat $ e: listAllInfos i) | 252 | Left (fn, pShow -> e) -> Right ("error message", simpleShow $ vcat $ e: listAllInfos fn i) |
253 | Right _ -> Left (tab "!Failed" "failed to catch error", Failed) | 253 | Right _ -> Left (tab "!Failed" "failed to catch error", Failed) |
254 | where | 254 | where |
255 | showGE fname ge = "------------ desugared source code": intersperse "" (map pShow desug) | 255 | showGE fname ge = "------------ desugared source code": intersperse "" (map pShow desug) |
256 | ++ "------------ core code": intersperse "" | 256 | ++ "------------ core code": intersperse "" |
257 | [ DAnn (text n) (DResetFreshNames $ pShow t) | 257 | [ DAnn (text n) (DResetFreshNames $ pShow t) |
258 | <$$> DLet "=" (text n) (DResetFreshNames $ mkDoc (False, True) e) | 258 | <$$> DLet "=" (text n) (DResetFreshNames $ mkDoc (False, True) e) |
259 | | (n, (e, t, RangeSI (Range fi _ _))) <- Map.toList ge, fileId fi == fileId fname] | 259 | | (n, (e, t, RangeSI r)) <- Map.toList ge, rangeFile r == fname] |
260 | ++ listAllInfos' i | 260 | ++ listAllInfos' (Just fname) i |
261 | 261 | ||
262 | tab msg | 262 | tab msg |
263 | | isWip fn && cfgReject = const msg | 263 | | isWip fn && cfgReject = const msg |