app/Test.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE LambdaCase #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 module Test where
   5
   6 import Rehi hiding (main)
   7 import Rehi.Git.Types (Hash(Hash), hashString)
   8 import Rehi.Utils.Regex (regex_split)
   9 import Rehi.Utils.IO (getTemporaryDirectory,removeFile,openBinaryTempFile,readBinaryFile)
  10
  11 import Test.HUnit (test,(~:),(~=?),(~?=),(@=?),(@?=),(@?),runTestTT,assertFailure)
  12
  13 import Prelude hiding (putStrLn,putStr,writeFile,readFile)
  14
  15 import Control.Exception (ErrorCall(ErrorCall))
  16 import Control.Monad.Catch(finally,catch)
  17 import Control.Monad.State(execState)
  18 import Data.ByteString.Builder (toLazyByteString, word64HexFixed, string7)
  19 import Data.ByteString.Lazy (toStrict)
  20 import Data.List (isPrefixOf)
  21 import Data.Monoid ((<>))
  22 import System.Environment(getArgs)
  23 import System.IO(hClose)
  24
  25 import qualified Data.ByteString as B
  26 import qualified Data.ByteString.Char8 as BC
  27 import qualified Data.Map as M
  28 import qualified System.IO as SI
  29
  30 import Control.Exception (handle,SomeException(SomeException))
  31 import Data.Typeable (typeOf)
  32
  33 #ifdef mingw32_HOST_OS
  34 import Rehi.Utils.Win32bits (getFileNameInformation)
  35 import Rehi.Utils.Regex (regex_match)
  36 import qualified Graphics.Win32.Misc as WM
  37 import qualified System.Win32.File as WF
  38 #endif
  39
  40 main = do
  41   args <- getArgs
  42   case args of
  43     ["term"] -> do
  44 #ifdef mingw32_HOST_OS
  45       SI.putStr "ft: "
  46       stdoutH <- WM.getStdHandle WM.sTD_OUTPUT_HANDLE
  47       WF.getFileType stdoutH >>= print
  48       SI.putStr "fn: "
  49       getFileNameInformation stdoutH >>= print
  50 #else
  51       SI.putStrLn "terminal test implemented only for Windows"
  52 #endif
  53     _ -> runTestTT allTests >> pure ()
  54
  55 allTests = test [ "regex" ~:
  56                     [ "split keeps last " ~: regex_split "a b c" " " ~?= ["a", "b", "c"] ]
  57                 , "find_sequence" ~:
  58                     [ "linear" ~: test_findseq [(1,[2]),(2,[3]),(3,[4])] 4 1 [] ~?= Right [h 3, h 2, h 1]
  59                     , "diamond" ~: test_findseq [(4,[2,3]),(2,[1]),(3,[1]),(1,[0])] 0 4 [] ~?= Right (map h [1,3,2,4])
  60                     , "simple_branch" ~: test_findseq [(1,[2,3]),(2,[3,5])] 2 1 [] ~?= Right [h 1]
  61                     , "shortest" ~: test_findseq [(1,[2,3]),(2,[6]),(3,[4]),(4,[6]),(6,[7,10])] 6 1 [] ~?= Right (map h [2,1])
  62                     , "through" ~: test_findseq [(1,[2,3]),(2,[6]),(3,[4]),(4,[6]),(6,[7,10])] 6 1 [4] ~?= Right (map h [4,3,1])
  63                     , "parallel_throughs" ~: test_findseq [(1,[2,3]),(2,[6]),(3,[4]),(4,[6]),(6,[7,10])] 6 1 [2,4] ~?= Left "No path found"
  64                     , "inner merge" ~: test_findseq [(1,[2,5]),(2,[3]),(3,[4]),(4,[]),(5,[6]),(6,[3,7]),(7,[4])] 4 1 [] ~?= Right (map h [3,6,5,2,1])
  65                     , "inner merge through" ~: test_findseq [(1,[2,5]),(2,[3]),(3,[4]),(4,[]),(5,[6]),(6,[3,7]),(7,[4])] 4 1 [7] ~?= Right (map h [7,6,5,1]) ]
  66                 , "build_rebase_sequence" ~:
  67                     [ "1" ~: brs1 ~?= Right [Pick (hashes !! 0)]
  68                     , "2" ~: brs2 ~?= Right []
  69                     , "3" ~: brs3 ~?= Right [p 1
  70                                             , Mark "tmp_1"
  71                                             , p 3
  72                                             , Mark "tmp_2"
  73                                             , Reset "@tmp_1"
  74                                             , p 2
  75                                             , Merge (Just (hashes !! 4)) ["HEAD", "@tmp_2"] False False]
  76                     , "inner_merge_after_merge " ~: test_brs [(1,[2,3]),(2,[4]),(3,[4]),(4,[5,6]),(5,[7]),(6,[8])] 5 1 []
  77                                                       ~?= Right [ Merge (Just (hashes !! 4)) ["HEAD",hashes !! 6] False False
  78                                                                 , Mark "tmp_1", p 3, Mark "tmp_2", Reset "@tmp_1", p 2
  79                                                                 , Merge (Just (hashes !! 1)) ["HEAD","@tmp_2"] False False ] ]
  80                 , "parse_cli_p1" ~: p1 ~?= Run "origin/b4" Nothing [] (Just "origin/base") Nothing True
  81                 , "parse_cli" ~: test_parse_cli
  82                 , "parse_todo" ~:
  83                     [ "1" ~: tp1 >>= (@?= [Merge (Just "f1") ["HEAD", "f2"] False False])
  84                     , "2" ~: tp2 >>= (@?= [Edit "316bf9c"])
  85                     , "3" ~: tp3 >>= (@?= [Pick "316bf9c", Comment "test-comment\n"])]
  86                 , "save_todo" ~:
  87                     [ "1" ~: s1 >>= (@?= "merge --ours -c 1 HEAD,2 ???\n") ]
  88                 , "parse_commit_line" ~:
  89                     [ "1" ~: commitsRefs pl1 M.! "9ac82f5" ~?= Hash "9ac82f5327efe63acb5267d9d55edbd8576d9d26"
  90                     , "2" ~: entryBody (commitsByHash pl1 M.! Hash "9ac82f5327efe63acb5267d9d55edbd8576d9d26") ~?= "Merge remote-tracking branch 'origin/b2'\n\nresolve conflict also\n"]
  91                 , "comments_from_string" ~:
  92                     [ "normal" ~: comments_from_string "a\nb\n" 0 ~?= [UserComment "a", UserComment "b"]
  93                     , "pending line" ~: comments_from_string "a\nb" 0 ~?= [UserComment "a", UserComment "b"] ]
  94                     ]
  95   where
  96     p n = Pick (hashes !! n)
  97     h n = Hash (hashes !! n)
  98
  99 hashes = map (B.reverse . toStrict . toLazyByteString . (string7 (replicate 24 '0') <>) . word64HexFixed) [0 ..]
 100
 101 i2c (n,ps) = (Hash h, Entry h (Hash h) h phs (Hash h) h)
 102   where
 103     h = hashes !! n
 104     phs = map (Hash . (hashes !!)) ps
 105
 106 noCommits = Commits M.empty M.empty
 107
 108 test_brs commits from to throughs =
 109   build_rebase_sequence
 110     (Commits M.empty (M.fromList $ map i2c commits))
 111     (Hash (hashes !! from))
 112     (Hash (hashes !! to))
 113     (map (Hash . (hashes !!)) throughs)
 114
 115 test_findseq commits from to throughs =
 116   find_sequence
 117     (M.fromList $ map i2c commits)
 118     (Hash (hashes !! from))
 119     (Hash (hashes !! to))
 120     (map (Hash . (hashes !!)) throughs)
 121
 122 -- pick 0
 123 brs1 = test_brs [(0, [1])] 1 0 []
 124
 125 -- empty
 126 brs2 = test_brs [(1, [0]),(2, [1])] 2 2 []
 127
 128 -- p 1, mark, p 2, mark, reset, p 3, merge
 129 brs3 = test_brs [(1, [0]),(2, [1]),(3,[1]),(4,[2,3])] 0 4 []
 130
 131 -- Run "origin/b4" Nothing [] (Just "origin/base") Nothing True
 132 p1 = parse_cli ["-i","origin/b4","..origin/base"]
 133
 134 -- merge parse
 135 tp1 = runParseTodo "merge -c f1 HEAD,f2 Test subject\n"
 136
 137 tp2 = runParseTodo "edit 316bf9c init haskell project\n"
 138
 139 tp3 = runParseTodo "pick 316bf9c\ncomment {{{\ntest-comment\n}}}\n"
 140
 141 runParseTodo content = withTestFile $ \f h -> do
 142   let c = Commits M.empty M.empty
 143   finally
 144     (BC.hPut h content)
 145     (hClose h)
 146   read_todo f c
 147
 148 withTestFile func = do
 149   d <- getTemporaryDirectory
 150   (f,h) <- openBinaryTempFile d "test.txt"
 151   finally
 152     (func f h)
 153     (removeFile f)
 154
 155 s1 = withTestFile $ \f h -> do
 156   hClose h
 157   save_todo [Merge (Just "1") ["HEAD","2"] True False] f commitsEmpty
 158   readBinaryFile f
 159
 160 pl1 = execState
 161         (git_parse_commit_line ("9ac82f5327efe63acb5267d9d55edbd8576d9d26:9ac82f5:a93dcfc33f5b7639a9e7c96bfeec0831451a918f:"
 162                                 <> "97277bafae875c930ea7c4a338a82073c897f7f0 76dee8a19ec9fddea0a02d99b0d1e00b1ef1caba:"
 163                                 <> "Merge remote-tracking branch 'origin/b2'\n\nresolve conflict also\n"))
 164         noCommits
 165
 166 mustError expr p_msg =
 167   catch
 168     (seq expr (assertFailure "Must have fail"))
 169     (\case { ErrorCall m | p_msg m -> pure (); err -> (assertFailure (show err)) })
 170
 171 test_parse_cli =
 172   [ "regular" ~:
 173     [ parse_cli ["a"] ~?= Run "a" Nothing [] Nothing Nothing False
 174     , parse_cli ["a","c"] ~?= Run "a" Nothing [] Nothing (Just "c") False
 175     , parse_cli ["a","b..d","c"] ~?= Run "a" (Just "b") [] (Just "d") (Just "c") False
 176     , parse_cli ["a","b..","c"] ~?= Run "a" (Just "b") [] Nothing (Just "c") False
 177     , parse_cli ["a","..d","c"] ~?= Run "a" Nothing [] (Just "d") (Just "c") False
 178     , parse_cli ["a","b..e..d","c"] ~?= Run "a" (Just "b") ["e"] (Just "d") (Just "c") False
 179     , parse_cli ["a","..e..","c"] ~?= Run "a" Nothing ["e"] Nothing (Just "c") False
 180     , parse_cli ["a","..e.."] ~?= Run "a" Nothing ["e"] Nothing Nothing False
 181     , parse_cli ["a","b..e..f..d","c"] ~?= Run "a" (Just "b") ["e","f"] (Just "d") (Just "c") False
 182   , "failures" ~:
 183     [ mustError (runThroughs $ parse_cli ["a", "b...d"]) (isPrefixOf "Invalid source spec:") ] ] ]
 184
 185 demo_errors = do
 186   SI.hPutStrLn SI.stderr "---- removeFile ----"
 187   handleErrors (SI.hPutStrLn SI.stderr) (BC.hPutStrLn SI.stderr) (const $ pure ()) $ removeFile "/tmp/ergieurgerugergerg"
 188   SI.hPutStrLn SI.stderr "---- fail ----"
 189   handleErrors (SI.hPutStrLn SI.stderr) (BC.hPutStrLn SI.stderr) (const $ pure ()) $ fail "test"
 190   SI.hPutStrLn SI.stderr "---- error ----"
 191   handleErrors (SI.hPutStrLn SI.stderr) (BC.hPutStrLn SI.stderr) (const $ pure ()) $ error "test"