diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-02-15 15:58:16 +0100 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-02-15 16:13:39 +0100 |
commit | 3db0b64a6f3e28ae6cc351e6c84290d4db905fa7 (patch) | |
tree | 91cfd4aa41e5c827d03956458aba8858a1ef245d /test | |
parent | e2f4415e606cd7c1c2b6ca986c68f6f956bf1a6e (diff) |
put trace info in .out files
Diffstat (limited to 'test')
-rw-r--r-- | test/runTests.hs | 24 |
1 files changed, 11 insertions, 13 deletions
diff --git a/test/runTests.hs b/test/runTests.hs index 5c3cd2f4..9d435806 100644 --- a/test/runTests.hs +++ b/test/runTests.hs | |||
@@ -1,5 +1,6 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE LambdaCase #-} | 2 | {-# LANGUAGE LambdaCase #-} |
3 | {-# LANGUAGE ViewPatterns #-} | ||
3 | {-# LANGUAGE FlexibleContexts #-} | 4 | {-# LANGUAGE FlexibleContexts #-} |
4 | {-# LANGUAGE RecordWildCards #-} | 5 | {-# LANGUAGE RecordWildCards #-} |
5 | module Main where | 6 | module Main where |
@@ -180,22 +181,19 @@ doTest Config{..} (i, fn) = do | |||
180 | where | 181 | where |
181 | n = dropExtension fn | 182 | n = dropExtension fn |
182 | 183 | ||
183 | action = f <$> (Right <$> getDef n "main" Nothing) `catchMM` (return . Left) | 184 | action = f <$> (Right <$> getDef n "main" Nothing) `catchMM` (\e is -> return $ Left (e, is)) |
184 | 185 | ||
185 | f | not $ isReject fn = \case | 186 | f | not $ isReject fn = \case |
186 | Left e -> Left (tab "!Failed" e, Failed) | 187 | Left (e, i) -> Left (unlines $ tab "!Failed" e: listTraceInfos i, Failed) |
187 | Right (fname, Left e, i) | 188 | Right (fname, Left e, i) -> Right ("typechecked module" , unlines $ e: listAllInfos i) |
188 | -> Right ("typechecked module" | 189 | Right (fname, Right (e, te), force -> i) |
189 | , unlines $ e: listAllInfos i) | 190 | | te == outputType -> Right ("compiled pipeline", prettyShowUnlines $ compilePipeline OpenGL33 (e, te)) |
190 | Right (fname, Right (e, te), i) | 191 | | e == trueExp -> Right ("reducted main", ppShow e) |
191 | | True <- i `deepseq` False -> error "impossible" | 192 | | te == boolType -> Left (tab "!Failed" $ "main should be True but it is \n" ++ ppShow e, Failed) |
192 | | te == outputType -> Right ("compiled pipeline", prettyShowUnlines $ compilePipeline OpenGL33 (e, te)) | 193 | | otherwise -> Right ("reduced main " ++ ppShow te, ppShow e) |
193 | | e == trueExp -> Right ("reducted main", ppShow e) | ||
194 | | te == boolType -> Left (tab "!Failed" $ "main should be True but it is \n" ++ ppShow e, Failed) | ||
195 | | otherwise -> Right ("reduced main " ++ ppShow te, ppShow e) | ||
196 | | otherwise = \case | 194 | | otherwise = \case |
197 | Left e -> Right ("error message", e) | 195 | Left (e, i) -> Right ("error message", unlines $ e: listAllInfos i) |
198 | Right _ -> Left (tab "!Failed" "failed to catch error", Failed) | 196 | Right _ -> Left (tab "!Failed" "failed to catch error", Failed) |
199 | 197 | ||
200 | tab msg | 198 | tab msg |
201 | | isWip fn && cfgReject = const msg | 199 | | isWip fn && cfgReject = const msg |