1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{- git-annex test suite
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import Test.HUnit
import Test.HUnit.Tools
import System.Directory
import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files
import System.Posix.Env
import IO (bracket_, bracket)
import Control.Monad (unless, when)
import Data.List
import System.IO.Error
import qualified GitRepo as Git
import Locations
import Utility
import TypeInternals
main :: IO (Counts, Int)
main = do
-- Add current directory to the from of PATH, so git-annex etc will
-- be used, no matter where it is run from.
cwd <- getCurrentDirectory
p <- getEnvDefault "PATH" ""
setEnv "PATH" (cwd++":"++p) True
runVerboseTests $ TestList [quickchecks, toplevels]
quickchecks :: Test
quickchecks = TestLabel "quickchecks" $ TestList
[ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode
, qctest "prop_idempotent_fileKey" prop_idempotent_fileKey
, qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show
, qctest "prop_idempotent_shellEscape" prop_idempotent_shellEscape
, qctest "prop_idempotent_shellEscape_multiword" prop_idempotent_shellEscape_multiword
, qctest "prop_parentDir_basics" prop_parentDir_basics
, qctest "prop_relPathDirToDir_basics" prop_relPathDirToDir_basics
]
toplevels :: Test
toplevels = TestLabel "toplevel" $ TestList
[ test_init
, test_add
]
test_init :: Test
test_init = TestLabel "git-annex init" $ TestCase $ ingitrepo $ do
git_annex "init" ["-q", reponame] @? "init failed"
e <- doesFileExist annexlog
unless e $
assertFailure $ annexlog ++ " not created"
c <- readFile annexlog
unless (isInfixOf reponame c) $
assertFailure $ annexlog ++ " does not contain repo name"
where
annexlog = ".git-annex/uuid.log"
reponame = "test repo"
test_add :: Test
test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do
writeFile file content
git_annex "add" ["-q", "foo"] @? "add failed"
s <- getSymbolicLinkStatus file
unless (isSymbolicLink s) $
assertFailure "git-annex add did not create symlink"
c <- readFile file
unless (c == content) $
assertFailure "file content changed during git-annex add"
r <- try (writeFile file $ content++"bar")
case r of
Left _ -> return () -- expected permission error
Right _ -> assertFailure "was able to modify annexed file content"
where
file = "foo"
content = "foo file content"
git_annex :: String -> [String] -> IO Bool
git_annex command params = boolSystem "git-annex" (command:params)
inannex :: Assertion -> Assertion
inannex a = ingitrepo $ do
git_annex "init" ["-q", reponame] @? "init failed"
a
where
reponame = "test repo"
ingitrepo :: Assertion -> Assertion
ingitrepo a = withgitrepo $ \r -> do
cwd <- getCurrentDirectory
bracket_ (changeWorkingDirectory $ Git.workTree r)
(\_ -> changeWorkingDirectory cwd)
a
withgitrepo :: (Git.Repo -> Assertion) -> Assertion
withgitrepo = bracket setup cleanup
where
tmpdir = ".t"
repodir = tmpdir ++ "/repo"
setup = do
cleanup True
createDirectory tmpdir
ok <- boolSystem "git" ["init", "-q", repodir]
unless ok $
assertFailure "git init failed"
return $ Git.repoFromPath repodir
cleanup _ = do
e <- doesDirectoryExist tmpdir
when e $ do
-- git-annex prevents annexed file content
-- from being removed with permissions
-- bits; undo
_ <- boolSystem "chmod" ["+rw", "-R", tmpdir]
removeDirectoryRecursive tmpdir
|
