app/Test.hs

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