mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add more tests

Browse source
This commit is contained in:
Joey Hess 2011-01-04 21:27:08 -04:00
parent aedc46caca
commit a323463726
2 changed files with 32 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Utility.hs
View file

@ -19,8 +19,10 @@ module Utility (
readMaybe, readMaybe,
safeWriteFile, safeWriteFile,
prop_idempotent_shellescape, prop_idempotent_shellEscape,
prop_idempotent_shellescape_multiword prop_idempotent_shellEscape_multiword,
prop_parentDir_basics,
prop_relPathDirToDir_basics
) where ) where
import System.IO import System.IO
@ -45,7 +47,7 @@ readFileStrict :: FilePath -> IO String
readFileStrict f = readFile f >>= \s -> length s `seq` return s readFileStrict f = readFile f >>= \s -> length s `seq` return s
{- Returns the parent directory of a path. Parent of / is "" -} {- Returns the parent directory of a path. Parent of / is "" -}
parentDir :: String -> String parentDir :: FilePath -> FilePath
parentDir dir = parentDir dir =
if not $ null dirs if not $ null dirs
then slash ++ join s (take (length dirs - 1) dirs) then slash ++ join s (take (length dirs - 1) dirs)
@ -55,6 +57,14 @@ parentDir dir =
slash = if isAbsolute dir then s else "" slash = if isAbsolute dir then s else ""
s = [pathSeparator] s = [pathSeparator]
prop_parentDir_basics :: FilePath -> Bool
prop_parentDir_basics dir
| null dir = True
| dir == "/" = parentDir dir == ""
| otherwise = p /= dir
where
p = parentDir dir
{- Converts a filename into a normalized, absolute path. -} {- Converts a filename into a normalized, absolute path. -}
absPath :: FilePath -> IO FilePath absPath :: FilePath -> IO FilePath
absPath file = do absPath file = do
@ -97,6 +107,13 @@ relPathDirToDir from to =
numcommon = length common numcommon = length common
path = join s $ dotdots ++ uncommon path = join s $ dotdots ++ uncommon
prop_relPathDirToDir_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToDir_basics from to
| from == to = null r
| otherwise = not (null r) && (last r == '/')
where
r = relPathDirToDir from to
{- Run a system command, and returns True or False {- Run a system command, and returns True or False
- if it succeeded or failed. - if it succeeded or failed.
- -
@ -150,10 +167,10 @@ shellUnEscape s = word:(shellUnEscape rest)
| otherwise = inquote q (w++[c]) cs | otherwise = inquote q (w++[c]) cs
{- For quickcheck. -} {- For quickcheck. -}
prop_idempotent_shellescape :: String -> Bool prop_idempotent_shellEscape :: String -> Bool
prop_idempotent_shellescape s = [s] == (shellUnEscape $ shellEscape s) prop_idempotent_shellEscape s = [s] == (shellUnEscape $ shellEscape s)
prop_idempotent_shellescape_multiword :: [String] -> Bool prop_idempotent_shellEscape_multiword :: [String] -> Bool
prop_idempotent_shellescape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s) prop_idempotent_shellEscape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s)
{- Removes a FileMode from a file. {- Removes a FileMode from a file.
- For example, call with otherWriteMode to chmod o-w -} - For example, call with otherWriteMode to chmod o-w -}

15
test.hs
View file

@ -7,14 +7,15 @@ import Utility
import TypeInternals import TypeInternals
alltests :: [Test] alltests :: [Test]
alltests = [ alltests =
qctest "prop_idempotent_deencode" prop_idempotent_deencode, [ qctest "prop_idempotent_deencode" prop_idempotent_deencode
qctest "prop_idempotent_fileKey" prop_idempotent_fileKey, , qctest "prop_idempotent_fileKey" prop_idempotent_fileKey
qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show, , qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show
qctest "prop_idempotent_shellescape" prop_idempotent_shellescape, , qctest "prop_idempotent_shellEscape" prop_idempotent_shellEscape
qctest "prop_idempotent_shellescape_multiword" prop_idempotent_shellescape_multiword , qctest "prop_idempotent_shellEscape_multiword" prop_idempotent_shellEscape_multiword
, qctest "prop_parentDir_basics" prop_parentDir_basics
, qctest "prop_relPathDirToDir_basics" prop_relPathDirToDir_basics
] ]
main :: IO (Counts, Int) main :: IO (Counts, Int)
main = runVerboseTests (TestList alltests) main = runVerboseTests (TestList alltests)