Sergey Astanin avatar Sergey Astanin committed 73ed42e

Tests for new Monadic API.

Comments (0)

Files changed (9)

 >
 >
 > runUnitTests _ _ _ _ =
->   system "cd tests && runhaskell -lzip Tests.hs" >>=
->   onExit "Some tests did not pass." ()
+>   system "runhaskell -lzip runTests.hs" >>=
+>   onExit "\nSome tests did not pass." ()
 >
 > onExit :: String -> a -> ExitCode -> IO a
 > onExit errmsg okvalue r =
+module Tests.Common
+    ( testzip, testfiles, lastfile, lastfilesize
+    , world_txt
+    , toUpper, toLower, map2
+    ) where
+
+import Data.Char (toUpper, toLower)
+
+testzip = "Tests/test.zip"
+testfiles = [ "hello/", "hello/world.txt" ]
+lastfile = last testfiles
+lastfilesize = 71 :: Int
+
+world_txt = "And God saw everything that he had made,\
+            \ and behold, it was very good.\n"
+
+-- map odd positions with f, even positions with g
+map2 :: (a -> b) -> (a -> b) -> [a] -> [b]
+map2 f g [] = []
+map2 f g (x:xs) = (f x):map2 g f xs

Tests/LegacyTests.hs

+module Tests.LegacyTests
+    ( legacyTests
+    ) where
+
+import Codec.Archive.LibZip.LegacyZeroZero
+
+import Tests.Common
+
+import qualified Data.ByteString as B
+import Test.HUnit
+
+legacyTests = TestList
+  [ "read list of files" ~: do
+      files <- withZip testzip [] $ \z -> getFiles z [] :: IO [String]
+      files @?= testfiles
+  , "read file size" ~: do
+      sz <- withZip testzip [] $ \z -> getFileSize z lastfile []
+      sz @?= lastfilesize
+  , "case-insensitive file names" ~: do
+    sz <- withZip testzip [] $ \z ->
+          getFileSize z (map2 toUpper toLower $ lastfile) [FileNOCASE]
+    sz @?= lastfilesize
+  , "open error if exists (with ExclFlag)" ~: do
+    err <- catchZipError
+            (withZip testzip [ExclFlag] $ \_ -> return ErrOK)
+            (return . id)
+    err @?= ErrEXISTS
+  , "read file" ~: do
+    txt <- withZip testzip [] $ \z -> readZipFile z lastfile []
+    txt @?= toByteString world_txt
+  , "open file by index" ~: do
+    txt <- withZip testzip [] $ \z -> do
+        f <- fopen_index z 1 [] -- index 0 is of the parent dir
+        bytes <- fread f (length world_txt)
+        return $ B.pack bytes
+    txt @?= toByteString world_txt
+  ]
+
+
+toByteString :: String -> B.ByteString
+toByteString s = B.pack $ map (fromIntegral . fromEnum) s
+

Tests/MonadicTests.hs

+{-# LANGUAGE FlexibleInstances #-}
+module Tests.MonadicTests where
+
+import Codec.Archive.LibZip
+import Tests.Common
+
+import Data.Int (Int64)
+import Foreign.Storable
+import Foreign.Ptr (Ptr, castPtr)
+
+import System.Directory (doesFileExist, getTemporaryDirectory, removeFile)
+import System.FilePath ((</>))
+import Test.HUnit
+import qualified Control.Exception as E
+
+monadicTests = TestList
+  [ "read list of files" ~: do
+      files <- withArchive [] testzip $ fileNames []
+      files @?= testfiles
+  , "read file size" ~: do
+      sz <- withArchive [] testzip $ fileSize [] lastfile
+      sz @?= lastfilesize
+  , "case-insensitive file names" ~: do
+      sz <- withArchive [] testzip $
+              fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile)
+      sz @?= lastfilesize
+  , "open error if exists (with ExclFlag)" ~: do
+      err <- catchZipError
+             (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK)
+             (return . id)
+      err @?= ErrEXISTS
+  , "open error if archive does not exists" ~: do
+      err <- catchZipError
+             (withArchive [] "notexists.zip" $ return ErrOK)
+             (return . id)
+      err @?= ErrOPEN
+  , "read file" ~: do
+      txt <- withArchive [] testzip $ fileContents [] lastfile
+      txt @?= world_txt
+  , "read file by index" ~: do
+      txt <- withArchive [] testzip $ fileContentsIx [] (length testfiles - 1)
+      txt @?= world_txt
+  , "skipBytes/readBytes" ~: do
+      txt <- withArchive [] testzip $
+               fromFile [] lastfile $ do
+                  skipBytes 13
+                  readBytes 10
+      txt @?= (take 10 . drop 13 $ world_txt)
+  , "create an archive/use sourceBuffer" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_sourceBuffer.zip"
+      i <- withArchive [CreateFlag] tmpzip $ do
+           addDirectory "hello"
+           addFile "hello/world.txt" =<< sourceBuffer world_txt
+      tmpzip `doesExistAnd` \f -> do
+           txt <- withArchive [] f $ fileContents [] "hello/world.txt"
+           removeFile f
+           (txt, i) @?= (world_txt, 1)
+  , "create an archive/use sourceFile" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_sourceFile.zip"
+      tmpsrc <- getTmpFileName "test_LibZip_sourceFile.txt"
+      writeFile tmpsrc world_txt
+      withArchive [CreateFlag] tmpzip $
+           addFile "world.txt" =<< sourceFile tmpsrc 0 0
+      tmpzip `doesExistAnd` \f -> do
+           txt <- withArchive [] f $ fileContents [] "world.txt"
+           removeFile tmpzip
+           removeFile tmpsrc
+           txt @?= world_txt
+  , "create an archive/use sourceZip" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_sourceZip.zip"
+      withArchive [] testzip $ do
+           zsrc <- getZip
+           lift $ withArchive [CreateFlag] tmpzip $
+               addFile "world.txt" =<< sourceZip [] zsrc 1 0 0
+      tmpzip `doesExistAnd` \f -> do
+           txt <- withArchive [] f $ fileContents [] "world.txt"
+           removeFile tmpzip
+           txt @?= world_txt
+  , "create an archive/use sourcePure" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_sourcePure.zip"
+      let src = PureSource
+           { srcState = (0, length world_txt) -- needs a Storable instance
+           , srcSize = length world_txt
+           , srcMTime = Nothing
+           , readSrc = \len (pos,lft) ->
+                       let n = min len lft
+                           buf = take n . drop pos $ world_txt
+                       in  Just (n, buf, (pos+n,lft-n))
+           }
+      withArchive [CreateFlag] tmpzip $ do
+           addFile "world.txt" =<< sourcePure src
+      tmpzip `doesExistAnd` \f -> do
+           txt <- withArchive [] f $ fileContents [] "world.txt"
+           removeFile tmpzip
+           txt @?= world_txt
+  , "delete a file" ~: do
+      let orig = [("one", "one"), ("two", "two")]
+      let final = init orig
+      tmpzip <- getTmpFileName "test_LibZip_delete.zip"
+      mkArchive tmpzip orig
+      fs_orig <- withArchive [] tmpzip $ fileNames []
+      withArchive [] tmpzip $ deleteFile [] "two"
+      fs_final <- withArchive [] tmpzip $ fileNames []
+      removeFile tmpzip
+      (fs_orig, fs_final) @?= (map fst orig, map fst final)
+  , "attempt to delete a non-existing file" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_delete_ne.zip"
+      mkArchive tmpzip [("world.txt", world_txt)]
+      r1 <- catchZipError
+            (withArchive [] tmpzip $
+                         deleteFile [] "doesnotexist" >> return ErrOK)
+            (return . id)
+      r2 <- catchZipError
+            (withArchive [] tmpzip $
+                         deleteFileIx 100 >> return ErrOK)
+            (return . id)
+      removeFile tmpzip
+      (r1, r2) @?= (ErrNOENT, ErrINVAL)
+  , "rename a file" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_rename.zip"
+      mkArchive tmpzip [("world.txt", world_txt)]
+      fs <- withArchive [] tmpzip $ do
+              renameFile [] "world.txt" "hello.txt"
+              fileNames []
+      removeFile tmpzip
+      fs @?= ["hello.txt"]
+  , "attempt to rename a non-existing file" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_rename_ne.zip"
+      mkArchive tmpzip [("world.txt", world_txt)]
+      r <- catchZipError
+            (withArchive [] tmpzip $ do
+              renameFile [] "doesnotexist" "hello.txt"
+              return ErrOK)
+            (return . id)
+      removeFile tmpzip
+      r @?= ErrNOENT
+  , "attempt to rename to an empty name" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_rename_inval.zip"
+      mkArchive tmpzip [("world.txt", world_txt)]
+      r <- catchZipError
+             (withArchive [] tmpzip $ do
+              renameFile [] "world.txt" ""
+              return ErrOK)
+             (return . id)
+      removeFile tmpzip
+      r @?= ErrINVAL
+  , "replace a file" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_replace.zip"
+      mkArchive tmpzip [("hello/",""), ("hello/world.txt", "old contents")]
+      withArchive [] tmpzip $
+              replaceFile [] "hello/world.txt" =<< sourceBuffer world_txt
+      txt <- withArchive [] tmpzip $ fileContents [] "hello/world.txt"
+      txt @?= world_txt
+  , "set/get/remove archive comment" ~: do
+      c1 <- withArchive [] testzip $ getComment []
+      tmpzip <- getTmpFileName "test_LibZip_comment.zip"
+      mkArchive tmpzip [("hello/",""), ("hello/world.txt", world_txt)]
+      c2 <- withArchive [] tmpzip $ getComment []
+      let com = "this is a test"
+      withArchive [] tmpzip $ setComment com
+      c2_added <- withArchive [] tmpzip $ getComment []
+      withArchive [] tmpzip $ removeComment
+      c2_removed <- withArchive [] tmpzip $ getComment []
+      removeFile tmpzip
+      (c1, c2, c2_added, c2_removed) @?= (Nothing, Nothing, Just com, Nothing)
+  , "set/get/remove file comment" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_file_comment.zip"
+      let world_path = "hello/world.txt"
+      let world_comm = "this is a test"
+      mkArchive tmpzip [("hello/",undefined), (world_path,world_txt)]
+      let get_comm = withArchive [] tmpzip $ getFileComment [] world_path
+      c_off <- get_comm
+      withArchive [] tmpzip $ setFileComment [] world_path world_comm
+      c_on <- get_comm
+      withArchive [] tmpzip $ removeFileComment [] world_path
+      c_off' <- get_comm
+      removeFile tmpzip
+      (c_off, c_on, c_off') @?= (Nothing, Just world_comm, Nothing)
+  , "unchange file" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_unchange_file.zip"
+      mkArchive tmpzip [("world.txt",world_txt)]
+      c <- withArchive [] tmpzip $ do
+                          setFileComment [] "world.txt" "a comment to undo"
+                          unchangeFile [] "world.txt"
+                          getFileComment [] "world.txt"
+      removeFile tmpzip
+      c @?= Nothing
+  , "unchange archive" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_unchange.zip"
+      mkArchive tmpzip [("world.txt",world_txt)]
+      c <- withArchive [] tmpzip $ do
+                          setComment "a comment to undo"
+                          unchangeArchive
+                          getComment []
+      removeFile tmpzip
+      c @?= Nothing
+  , "unchange all" ~: do
+      tmpzip <- getTmpFileName "test_LibZip_unchange_all.zip"
+      mkArchive tmpzip [("world.txt",world_txt)]
+      c <- withArchive [] tmpzip $ do
+                          setComment "a comment to undo"
+                          setFileComment [] "world.txt" "a file comment to undo"
+                          unchangeAll
+                          c1 <- getComment []
+                          c2 <- getFileComment [] "world.txt"
+                          return (c1,c2)
+      removeFile tmpzip
+      c @?= (Nothing,Nothing)
+
+  ]
+
+getTmpFileName basename = do
+  tmpdir <- getTemporaryDirectory
+  let tmpfile = tmpdir </> basename
+  doesFileExist tmpfile >>= \b ->
+      if b
+         then removeFile tmpfile >> return tmpfile
+         else return tmpfile
+
+doesExistAnd filepath assertion = do
+  exists <- doesFileExist filepath
+  if exists
+    then assertion filepath
+    else False @? ( "File " ++ filepath ++ " does not exist." )
+
+-- for sourcePure, requires FlexibleInstances
+instance Storable (Int,Int) where
+    sizeOf _ = 2 * sizeOf (0::Int)
+    alignment _ = alignment (0::Int)
+    peek ptr = do
+      let ptr' = castPtr ptr :: Ptr Int
+      a <- peekElemOff ptr' 0
+      b <- peekElemOff ptr' 1
+      return (a, b)
+    poke ptr (a,b) = do
+      let ptr' = castPtr ptr :: Ptr Int
+      pokeElemOff ptr' 0 $ a
+      pokeElemOff ptr' 1 $ b
+
+mkArchive :: (Enum a) => FilePath -> [(FilePath, [a])] -> IO ()
+mkArchive zipname contents =
+  withArchive [CreateFlag] zipname $
+    mapM_ (\(f,d) ->
+               if last f == '/'
+                  then addDirectory f
+                  else addFile f =<< sourceBuffer d
+          ) contents
+  
+
+  
+import Codec.Archive.LibZip
+
+import Tests.Common
+import Tests.LegacyTests (legacyTests)
+
+import System.Exit
+import Test.HUnit
+import qualified Control.Exception as E
+
+monadicTests = TestList
+  [ "read list of files" ~: do
+      files <- withArchive [] testzip $ fileNames []
+      files @?= testfiles
+  , "read file size" ~: do
+      sz <- withArchive [] testzip $ fileSize [] lastfile
+      sz @?= lastfilesize
+  , "case-insensitive file names" ~: do
+      sz <- withArchive [] testzip $
+              fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile)
+      sz @?= lastfilesize
+  , "open error if exists (with ExclFlag)" ~: do
+      err <- catchZipError
+             (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK)
+             (return . id)
+      err @?= ErrEXISTS
+  , "open error if archive does not exists" ~: do
+      err <- catchZipError
+             (withArchive [] "notexists.zip" $ return ErrOK)
+             (return . id)
+      err @?= ErrOPEN
+  , "read file" ~: do
+      txt <- withArchive [] testzip $ fileContents [] lastfile
+      txt @?= world_txt
+  , "read file by index" ~: do
+      txt <- withArchive [] testzip $ fileContentsIx [] (length testfiles - 1)
+      txt @?= world_txt
+  , "skipBytes/readBytes" ~: do
+      txt <- withArchive [] testzip $
+               fromFile [] lastfile $ do
+                  skipBytes 13
+                  readBytes 10
+      txt @?= (take 10 . drop 13 $ world_txt)
+  ]
+
+allTests = TestList
+  [ "Legacy API" ~: legacyTests
+  , "Monadic API" ~: monadicTests
+  ]
+
+main = do
+  result <- runTestTT allTests
+  if (errors result + failures result) > 0
+    then exitFailure
+    else exitSuccess
+

Binary file added.

+import Tests.LegacyTests (legacyTests)
+import Tests.MonadicTests (monadicTests)
+
+import System.Exit
+import Test.HUnit
+
+allTests = TestList
+  [ "Legacy API" ~: legacyTests
+  , "Monadic API" ~: monadicTests
+  ]
+
+main = do
+  result <- runTestTT allTests
+  if (errors result + failures result) > 0
+    then exitFailure
+    else exitSuccess
+

tests/Tests.hs

-import Codec.Archive.LibZip.LegacyZeroZero
-import Data.Char (toUpper, toLower)
-import System.Exit
-import Test.HUnit
-import qualified Data.ByteString as B
-
-testzip = "test.zip"
-testfiles = [ "hello/", "hello/world.txt" ]
-
-world_txt = toByteString "And God saw everything that he had made,\
-                         \ and behold, it was very good.\n"
-
-main = do
-  result <- runTestTT $ TestList
-    [ "read list of files" ~: do
-        files <- withZip testzip [] $ \z -> getFiles z [] :: IO [String]
-        files @?= testfiles
-    , "read file size" ~: do
-        sz <- withZip testzip [] $ \z -> getFileSize z (last testfiles) []
-        sz @?= 71
-    , "case-insensitive file names" ~: do
-        sz <- withZip testzip [] $ \z ->
-              getFileSize z (map2 toUpper toLower $ last testfiles) [FileNOCASE]
-        sz @?= 71
-    , "open error if exists (with ExclFlag)" ~: do
-        err <- catchZipError
-                (withZip testzip [ExclFlag] $ \_ -> return ErrOK)
-                (return . id)
-        err @?= ErrEXISTS
-    , "read file" ~: do
-        txt <- withZip testzip [] $ \z -> readZipFile z (last testfiles) []
-        txt @?= world_txt
-    , "open file by index" ~: do
-        txt <- withZip testzip [] $ \z -> do
-            f <- fopen_index z 1 [] -- index 0 is of the parent dir
-            bytes <- fread f (B.length world_txt)
-            return $ B.pack bytes
-        txt @?= world_txt
-    ]
-  if (errors result + failures result) > 0
-    then exitFailure
-    else exitSuccess
-
-toByteString :: String -> B.ByteString
-toByteString s = B.pack $ map (fromIntegral . fromEnum) s
-
--- map odd positions with f, even positions with g
-map2 :: (a -> b) -> (a -> b) -> [a] -> [b]
-map2 f g [] = []
-map2 f g (x:xs) = (f x):map2 g f xs

Binary file removed.

Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.