diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-02-15 20:18:02 +0100 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-02-15 20:31:06 +0100 |
commit | f29d1fc2a330b54ad57d3cb21f0f24d5714de331 (patch) | |
tree | a556b627147e10b12db51408fd97c45701fe2097 /test/runTests.hs | |
parent | 35e7f0ba7365059d8b7df9cacd4e180fff3179c1 (diff) |
use patience diff
Diffstat (limited to 'test/runTests.hs')
-rw-r--r-- | test/runTests.hs | 51 |
1 files changed, 22 insertions, 29 deletions
diff --git a/test/runTests.hs b/test/runTests.hs index ef331966..8503cf8a 100644 --- a/test/runTests.hs +++ b/test/runTests.hs | |||
@@ -8,6 +8,7 @@ module Main where | |||
8 | import Data.List | 8 | import Data.List |
9 | import Data.Either | 9 | import Data.Either |
10 | import Data.Time.Clock | 10 | import Data.Time.Clock |
11 | import Data.Algorithm.Patience | ||
11 | import Control.Applicative | 12 | import Control.Applicative |
12 | import Control.Concurrent | 13 | import Control.Concurrent |
13 | import Control.Concurrent.Async | 14 | import Control.Concurrent.Async |
@@ -27,6 +28,7 @@ import qualified Data.Text.IO as TIO | |||
27 | import Text.Printf | 28 | import Text.Printf |
28 | 29 | ||
29 | import LambdaCube.Compiler | 30 | import LambdaCube.Compiler |
31 | import LambdaCube.Compiler.Pretty hiding ((</>)) | ||
30 | 32 | ||
31 | ------------------------------------------ utils | 33 | ------------------------------------------ utils |
32 | 34 | ||
@@ -93,7 +95,7 @@ arguments = | |||
93 | ) | 95 | ) |
94 | <*> many (strArgument idm) | 96 | <*> many (strArgument idm) |
95 | 97 | ||
96 | data Res = Passed | Accepted | New | TimedOut | Rejected | Failed | ErrorCatched | 98 | data Res = Passed | Accepted | NewRes | TimedOut | Rejected | Failed | ErrorCatched |
97 | deriving (Eq, Ord, Show) | 99 | deriving (Eq, Ord, Show) |
98 | 100 | ||
99 | showRes = \case | 101 | showRes = \case |
@@ -101,7 +103,7 @@ showRes = \case | |||
101 | Failed -> "failed test" | 103 | Failed -> "failed test" |
102 | Rejected -> "rejected result" | 104 | Rejected -> "rejected result" |
103 | TimedOut -> "timed out test" | 105 | TimedOut -> "timed out test" |
104 | New -> "new result" | 106 | NewRes -> "new result" |
105 | Accepted -> "accepted result" | 107 | Accepted -> "accepted result" |
106 | Passed -> "passed test" | 108 | Passed -> "passed test" |
107 | 109 | ||
@@ -157,7 +159,7 @@ main = do | |||
157 | putStrLn $ unlines $ reverse $ | 159 | putStrLn $ unlines $ reverse $ |
158 | concat [ sh (\s ty -> ty == x && p s) (w ++ showRes x) | 160 | concat [ sh (\s ty -> ty == x && p s) (w ++ showRes x) |
159 | | (w, p) <- [("", not . isWip), ("wip ", isWip)] | 161 | | (w, p) <- [("", not . isWip), ("wip ", isWip)] |
160 | , x <- [ErrorCatched, Failed, Rejected, TimedOut, New, Accepted] | 162 | , x <- [ErrorCatched, Failed, Rejected, TimedOut, NewRes, Accepted] |
161 | ] | 163 | ] |
162 | ++ sh (\s ty -> ty == Passed && isWip s) "wip passed test" | 164 | ++ sh (\s ty -> ty == Passed && isWip s) "wip passed test" |
163 | 165 | ||
@@ -208,44 +210,35 @@ doTest Config{..} (i, fn) = do | |||
208 | compareResult msg ef e = doesFileExist ef >>= \b -> case b of | 210 | compareResult msg ef e = doesFileExist ef >>= \b -> case b of |
209 | False | 211 | False |
210 | | cfgReject -> return ("!Missing .out file", Rejected) | 212 | | cfgReject -> return ("!Missing .out file", Rejected) |
211 | | otherwise -> writeFile ef e >> return ("New .out file", New) | 213 | | otherwise -> writeFile ef e >> return ("New .out file", NewRes) |
212 | True -> do | 214 | True -> do |
213 | e' <- readFileStrict ef | 215 | e' <- lines <$> readFileStrict ef |
214 | case map fst $ filter snd $ zip [0..] $ zipWith (/=) e e' ++ replicate (abs $ length e - length e') True of | 216 | let d = diff e' $ lines e |
215 | [] -> return ("OK", Passed) | 217 | case d of |
218 | _ | all (\case Both{} -> True; _ -> False) d -> return ("OK", Passed) | ||
216 | rs | cfgReject-> return ("!Different .out file", Rejected) | 219 | rs | cfgReject-> return ("!Different .out file", Rejected) |
217 | | otherwise -> do | 220 | | otherwise -> do |
218 | printOldNew msg (showRanges ef rs e') (showRanges ef rs e) | 221 | mapM_ putStrLn $ printOldNew msg d |
219 | putStrLn $ ef ++ " has changed." | 222 | putStrLn $ ef ++ " has changed." |
220 | putStr $ "Accept new " ++ msg ++ " (y/n)? " | 223 | putStr $ "Accept new " ++ msg ++ " (y/n)? " |
221 | c <- length e' `seq` getYNChar | 224 | c <- getYNChar |
222 | if c | 225 | if c |
223 | then writeFile ef e >> return ("Accepted .out file", Accepted) | 226 | then writeFile ef e >> return ("Accepted .out file", Accepted) |
224 | else return ("!Rejected .out file", Rejected) | 227 | else return ("!Rejected .out file", Rejected) |
225 | 228 | ||
226 | printOldNew msg old new = do | 229 | printOldNew :: String -> [Item String] -> [String] |
227 | putStrLn $ msg ++ " has changed." | 230 | printOldNew msg d = (msg ++ " has changed.") : ff [] 0 d |
228 | putStrLn "------------------------------------------- Old" | 231 | where |
229 | putStrLn old | 232 | ff acc n (x@(Both a b): ds) = [a' | n < 5] ++ ff (a':acc) (n+1) ds where a' = " " ++ a |
230 | putStrLn "------------------------------------------- New" | 233 | ff acc n (Old a: ds) = g acc n ++ (ESC "42" ("< " ++ ESC "49" a)): ff [] 0 ds |
231 | putStrLn new | 234 | ff acc n (New b: ds) = g acc n ++ (ESC "41" ("> " ++ ESC "49" b)): ff [] 0 ds |
232 | putStrLn "-------------------------------------------" | 235 | ff _ _ [] = [] |
236 | g acc n | n < 5 = [] | ||
237 | g acc n | n > 10 = "___________": reverse (take 5 acc) | ||
238 | g acc n = reverse (take (n-5) acc) | ||
233 | 239 | ||
234 | pad n s = s ++ replicate (n - length s) ' ' | 240 | pad n s = s ++ replicate (n - length s) ' ' |
235 | 241 | ||
236 | limit :: String -> Int -> String -> String | 242 | limit :: String -> Int -> String -> String |
237 | limit msg n s = take n s ++ if null (drop n s) then "" else msg | 243 | limit msg n s = take n s ++ if null (drop n s) then "" else msg |
238 | 244 | ||
239 | showRanges :: String -> [Int] -> String -> String | ||
240 | showRanges fname is e = (if head rs == 0 then "" else "...\n") | ||
241 | ++ limit ("\n... (see " ++ fname ++ " for more differences)") 140000 (intercalate "\n...\n" $ f (zipWith (-) rs (0:rs)) e) | ||
242 | where | ||
243 | f :: [Int] -> String -> [String] | ||
244 | f (i:is) e = g is $ drop i e | ||
245 | f [] "" = [] | ||
246 | f [] _ = ["\n..."] | ||
247 | g (i:is) e = take i e: f is (drop i e) | ||
248 | rs = (head is - x) : concat [[a + x, b - x] | (a, b) <- zip is (tail is), a + y < b] ++ [last is + x] | ||
249 | x = 100000 | ||
250 | y = 3*x | ||
251 | |||