gitlib-test 1.2.0 → 1.3.1

raw patch · 2 files changed

+249/−107 lines, 2 filesdep +bytestringdep +textdep −gitlib-utilsdep ~gitlibPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, text

Dependencies removed: gitlib-utils

Dependency ranges changed: gitlib

API changes (from Hackage documentation)

Files

• Git/Smoke.hs +243/−102
• gitlib-test.cabal +6/−5

@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}@@ -9,25 +10,32 @@  module Git.Smoke where -import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Trans.Control-import Data.List (sort)-import Data.Tagged-import Data.Time-import Data.Time.Clock.POSIX-import Git-import Git.Utils-import Prelude hiding (FilePath, putStr)-import Test.HUnit-import Test.Hspec (Spec, describe, it)-import Test.Hspec.HUnit ()+import           Control.Applicative+import           Control.Exception+import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Control+import           Data.List (sort)+import           Data.Monoid+import           Data.Tagged+import qualified Data.Text as T (Text, pack)+import qualified Data.Text.Encoding as T (decodeUtf8)+import           Data.Time+import           Data.Time.Clock.POSIX+import           Data.Typeable+import           Filesystem.Path.CurrentOS (FilePath, fromText, toText,+                                            filename)+import           Git+import           Prelude hiding (FilePath, putStr)+import           Test.HUnit+import           Test.Hspec (Spec, Example, describe, it)+import           Test.Hspec.Expectations+import           Test.Hspec.HUnit () -sampleCommit :: Repository m => Tree m (TreeKind m) -> Signature -> m (Commit m)+sampleCommit :: Repository m => TreeRef m -> Signature -> m (Commit m) sampleCommit tr sig =-    createCommit [] (treeRef tr) sig sig "Sample log message.\n" Nothing+    createCommit [] tr sig sig "Sample log message.\n" Nothing  smokeTestSpec :: (Repository (t IO), MonadGit (t IO), MonadTrans t,                   Repository (t2 (t IO)), MonadGit (t2 (t IO)), MonadTrans t2,@@ -49,42 +57,42 @@   it "create a single tree" $ withNewRepository pr "singleTree.git" $ do       hello <- createBlobUtf8 "Hello, world!\n"       tr <- createTree $ putBlob "hello/world.txt" hello-      x <- treeOid tr+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"        toid <- Git.parseOid "c0c848a2737a6a8533a18e6bd4d04266225e0271"       tr <- lookupTree (Tagged toid)-      x <- treeOid tr+      let x = renderObjOid $ treeOid tr       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"    it "create two trees" $ withNewRepository pr "twoTrees.git" $ do       hello <- createBlobUtf8 "Hello, world!\n"       tr <- createTree $ putBlob "hello/world.txt" hello-      x <- treeOid tr+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"        goodbye <- createBlobUtf8 "Goodbye, world!\n"-      tr <- mutateTree tr $ putBlob "goodbye/files/world.txt" goodbye-      x <- treeOid tr+      tr <- mutateTreeRef tr $ putBlob "goodbye/files/world.txt" goodbye+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"    it "delete an item from a tree" $ withNewRepository pr "deleteTree.git" $ do       hello <- createBlobUtf8 "Hello, world!\n"       tr <- createTree $ putBlob "hello/world.txt" hello-      x <- treeOid tr+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271" -      tr <- mutateTree tr $+      tr <- mutateTreeRef tr $           putBlob "goodbye/files/world.txt"               =<< lift (createBlobUtf8 "Goodbye, world!\n")-      x <- treeOid tr+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"        -- Confirm that deleting world.txt also deletes the now-empty       -- subtree goodbye/files, which also deletes the then-empty subtree       -- goodbye, returning us back the original tree.-      tr <- mutateTree tr $ dropEntry "goodbye/files/world.txt"-      x <- treeOid tr+      tr <- mutateTreeRef tr $ dropEntry "goodbye/files/world.txt"+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"    it "create a single commit" $ withNewRepository pr "createCommit.git" $ do@@ -92,8 +100,8 @@       tr <- createTree $ putBlob "hello/world.txt" hello        goodbye <- createBlobUtf8 "Goodbye, world!\n"-      tr <- mutateTree tr $ putBlob "goodbye/files/world.txt" goodbye-      x <- treeOid tr+      tr <- mutateTreeRef tr $ putBlob "goodbye/files/world.txt" goodbye+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"        -- The Oid has been cleared in tr, so this tests that it gets@@ -115,8 +123,7 @@   it "modify a commit" $ withNewRepository pr "modifyCommit.git" $ do       hello <- createBlobUtf8 "Hello, world!\n"       tr <- createTree $ putBlob "hello/world.txt" hello-      oid <- Git.writeTree tr-      let x = renderObjOid oid+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"        let sig  = Signature {@@ -128,12 +135,11 @@       let x = renderObjOid (commitOid c)       liftIO $ x @?= "d592871f56aa949d726fcc211370d1af305e9597" -      tr' <- Git.resolveTreeRef (Git.commitTree c)       goodbye <- createBlobUtf8 "Goodbye, world!\n"-      tr' <- mutateTree tr' $ putBlob "hello/goodbye.txt" goodbye+      tr' <- mutateTreeRef (Git.commitTree c) $+                 putBlob "hello/goodbye.txt" goodbye -      oid <- Git.writeTree tr'-      let x = renderObjOid oid+      let x = renderObjOid (treeRefOid tr')       liftIO $ x @?= "19974fde643bddd26c46052f7a8bdf87f7772c1e"        let sig  = Signature {@@ -141,8 +147,8 @@             , signatureEmail = "johnw@fpcomplete.com"             , signatureWhen  = fakeTime 1348980883 } -      c <- createCommit [commitRef c] (treeRef tr') sig sig-                       "Sample log message 2.\n" (Just "refs/heads/master")+      c <- createCommit [commitRef c] tr' sig sig+               "Sample log message 2.\n" (Just "refs/heads/master")       let x = renderObjOid (commitOid c)       liftIO $ x @?= "61a2c6425d2e60a480d272aa921d4f4ffe5dd20f" @@ -151,8 +157,8 @@       tr <- createTree $ putBlob "hello/world.txt" hello        goodbye <- createBlobUtf8 "Goodbye, world!\n"-      tr <- mutateTree tr $ putBlob "goodbye/files/world.txt" goodbye-      x <- treeOid tr+      tr <- mutateTreeRef tr $ putBlob "goodbye/files/world.txt" goodbye+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"        -- The Oid has been cleared in tr, so this tests that it gets written as@@ -166,30 +172,30 @@       liftIO $ x @?= "4e0529eb30f53e65c1e13836e73023c9d23c25ae"        goodbye2 <- createBlobUtf8 "Goodbye, world again!\n"-      tr <- mutateTree tr $ putBlob "goodbye/files/world.txt" goodbye2-      x <- treeOid tr+      tr <- mutateTreeRef tr $ putBlob "goodbye/files/world.txt" goodbye2+      let x = renderObjOid (treeRefOid tr)       liftIO $ x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706"        let sig = Signature {               signatureName  = "John Wiegley"             , signatureEmail = "johnw@fpcomplete.com"             , signatureWhen  = fakeTime 1348981883 }-      c2 <- createCommit [commitRef c] (treeRef tr) sig sig-                        "Second sample log message.\n" Nothing+      c2 <- createCommit [commitRef c] tr sig sig+                "Second sample log message.\n" Nothing       let x = renderObjOid (commitOid c2)       liftIO $ x @?= "967b647bd11990d1bb15ff5209ad44a002779454" -      updateRef_ "refs/heads/master" (RefObj (commitRef c2))+      updateReference_ "refs/heads/master" (RefObj (commitRef c2))       hasSymRefs <- hasSymbolicReferences <$> facts       when hasSymRefs $-          updateRef_ "HEAD" (RefSymbolic "refs/heads/master")+          updateReference_ "HEAD" (RefSymbolic "refs/heads/master") -      Just c3 <- resolveRef "refs/heads/master"+      Just c3 <- resolveReference "refs/heads/master"       c3 <- resolveCommitRef c3       let x = renderObjOid (commitOid c3)       liftIO $ x @?= "967b647bd11990d1bb15ff5209ad44a002779454" -      refs <- allRefNames+      refs <- allReferenceNames       liftIO $ show refs @?= "[\"refs/heads/master\"]"        -- jww (2013-01-27): Restore@@ -215,11 +221,11 @@                           , signatureWhen  = fakeTime 1348981883 }       blob <- createBlobUtf8 "# Auto-createdsitory for tutorial contents\n"       tree <- createTree $ putBlob "README.md" blob-      commit <- createCommit [] (treeRef tree) sig sig "Initial commit" Nothing+      commit <- createCommit [] tree sig sig "Initial commit" Nothing        blob <- createBlobUtf8 "This is some content."-      tree <- mutateTree tree $ putBlob "foo.txt" blob-      createCommit [commitRef commit] (treeRef tree) sig sig+      tree <- mutateTreeRef tree $ putBlob "foo.txt" blob+      createCommit [commitRef commit] tree sig sig           "This is another log message." (Just masterRef)        liftIO $ True @?= True@@ -231,70 +237,205 @@               , signatureEmail = "user1@email.org"               , signatureWhen  = fakeTime 1348981883 }       tree <- createTree $ do-          putBlob "One"         =<< lift (createBlobUtf8 "One\n")-          putBlob "Two"         =<< lift (createBlobUtf8 "Two\n")-          putBlob "Files/Three" =<< lift (createBlobUtf8 "Three\n")-          putBlob "More/Four"   =<< lift (createBlobUtf8 "Four\n")-      createCommit [] (treeRef tree) sig sig "Initial commit"-          (Just masterRef)--      paths <- flip traverseEntries tree $ \fp _ -> return fp-      liftIO $ sort paths @?= [ "Files", "More", "One", "Two"-                              , "Files/Three", "More/Four" ]+          putBlob "One"            =<< lift (createBlobUtf8 "One\n")+          putBlob "Two"            =<< lift (createBlobUtf8 "Two\n")+          putBlob "Files/Three"    =<< lift (createBlobUtf8 "Three\n")+          putBlob "More/Four"      =<< lift (createBlobUtf8 "Four\n")+          putBlob "Five/More/Four" =<< lift (createBlobUtf8 "Five\n")+      createCommit [] tree sig sig "Initial commit" (Just masterRef) -  -- it "push commit between repositories" $ do-  --     let masterRef = "refs/heads/master"-  --         sig = Signature { signatureName   = "First Name"-  --                         , signatureEmail = "user1@email.org"-  --                         , signatureWhen  = fakeTime 1348981883 }+      tree' <- resolveTreeRef tree+      paths <- traverseEntries (const . return) tree'+      liftIO $ sort paths @?= [ "Files"+                              , "Five"+                              , "More"+                              , "One"+                              , "Two"+                              , "Files/Three"+                              , "Five/More"+                              , "Five/More/Four"+                              , "More/Four"+                              ]++  treeit "adds a file" pr+      [ Bl "one"+      ] $ do+          putBlob "one" =<< lift (createBlobUtf8 "one\n") -  --     withNewRepository pr "pushSource.git" $ do-  --         tree <- newTree+  treeit "adds two files" pr+      [ Bl "one"+      , Bl "two"+      ] $ do+          putBlob "one" =<< lift (createBlobUtf8 "one\n")+          putBlob "two" =<< lift (createBlobUtf8 "two\n") -  --         putBlob tree "foo/README.md"-  --             =<< createBlobUtf8 "one\n"-  --         c <- createCommit [] (treeRef tree) sig sig-  --                  "Initial commit.\n" Nothing+  treeit "adds three files" pr+      [ Bl "one"+      , Bl "three"+      , Bl "two"+      ] $ do+          putBlob "one" =<< lift (createBlobUtf8 "one\n")+          putBlob "two" =<< lift (createBlobUtf8 "two\n")+          putBlob "three" =<< lift (createBlobUtf8 "three\n") -  --         putBlob tree "bar/foo.txt"-  --             =<< createBlobUtf8 "This is some content."-  --         c <- createCommit [commitRef c] (treeRef tree) sig sig-  --                  "This is another log message.\n" (Just masterRef)+  treeit "adds a file at a subpath" pr+      [ Tr "a"+      , Bl "a/one"+      ] $ do+          putBlob "a/one" =<< lift (createBlobUtf8 "one\n") -  --         putBlob tree "foo/bar/baz.txt"-  --             =<< createBlobUtf8 "This is some content."-  --         c <- createCommit [commitRef c] (treeRef tree) sig sig-  --                  "This is another log message.\n" (Just masterRef)+  treeit "adds a file at a deep subpath" pr+      [ Tr "a"+      , Tr "a/b"+      , Tr "a/b/c"+      , Tr "a/b/c/d"+      , Tr "a/b/c/d/e"+      , Bl "a/b/c/d/e/one"+      ] $ do+          putBlob "a/b/c/d/e/one" =<< lift (createBlobUtf8 "one\n") -  --         putBlob tree "bar/bar.txt"-  --             =<< createBlobUtf8 "This is some content."-  --         c <- createCommit [commitRef c] (treeRef tree) sig sig-  --                  "This is another log message.\n" (Just masterRef)+  treeit "adds files at multiple depths" pr+      [ Tr "a"+      , Tr "a/b"+      , Bl "a/one"+      , Tr "a/b/c"+      , Bl "a/b/two"+      , Tr "a/b/c/d"+      , Bl "a/b/c/three"+      , Tr "a/b/c/d/e"+      , Bl "a/b/c/d/four"+      , Bl "a/b/c/d/e/five"+      ] $ do+          putBlob "a/one" =<< lift (createBlobUtf8 "one\n")+          putBlob "a/b/two" =<< lift (createBlobUtf8 "two\n")+          putBlob "a/b/c/three" =<< lift (createBlobUtf8 "three\n")+          putBlob "a/b/c/d/four" =<< lift (createBlobUtf8 "four\n")+          putBlob "a/b/c/d/e/five" =<< lift (createBlobUtf8 "five\n") -  --         putBlob tree "foo/hello.txt"-  --             =<< createBlobUtf8 "This is some content."-  --         c <- createCommit [commitRef c] (treeRef tree) sig sig-  --                  "This is another log message.\n" (Just masterRef)+  treeit "adds files at mixed depths" pr+      [ Tr "a"+      , Tr "b"+      , Tr "d"+      , Tr "g"+      , Tr "k"+      , Bl "a/one"+      , Tr "b/c"+      , Bl "b/c/two"+      , Tr "d/e"+      , Tr "d/e/f"+      , Bl "d/e/f/three"+      , Tr "g/h"+      , Tr "g/h/i"+      , Tr "g/h/i/j"+      , Bl "g/h/i/j/four"+      , Tr "k/l"+      , Tr "k/l/m"+      , Tr "k/l/m/n"+      , Tr "k/l/m/n/o"+      , Bl "k/l/m/n/o/five"+      ] $ do+          putBlob "a/one" =<< lift (createBlobUtf8 "one\n")+          putBlob "b/c/two" =<< lift (createBlobUtf8 "two\n")+          putBlob "d/e/f/three" =<< lift (createBlobUtf8 "three\n")+          putBlob "g/h/i/j/four" =<< lift (createBlobUtf8 "four\n")+          putBlob "k/l/m/n/o/five" =<< lift (createBlobUtf8 "five\n") -  --         Just cref <- resolveRef masterRef-  --         let coid = renderObjOid (commitRefOid cref)+  treeit "adds and drops a file" pr+      [] $ do+          putBlob "one" =<< lift (createBlobUtf8 "one\n")+          dropEntry "one" -  --         withNewRepository pr2 "pushDest.git" $ do-  --             pushCommit (CommitRefName masterRef) Nothing masterRef-  --             mref2 <- lookupRef masterRef-  --             Just cref <- referenceToRef Nothing mref2-  --             lift . lift $-  --                 coid @?= renderObjOid (commitRefOid cref)+  treeit "adds two files and drops one" pr+      [ Bl "one"+      ] $ do+          putBlob "one" =<< lift (createBlobUtf8 "one\n")+          putBlob "two" =<< lift (createBlobUtf8 "two\n")+          dropEntry "two" -  --         withNewRepository pr2 "pushDest.git" $ do-  --             pushCommit (CommitRefName masterRef)-  --                 (Just "file://pushDest.git") masterRef-  --             mref2 <- lookupRef masterRef-  --             Just cref <- referenceToRef Nothing mref2-  --             lift . lift $-  --                 coid @?= renderObjOid (commitRefOid cref)+  treeit "adds and drops files at mixed depths" pr+      [ Tr "a"+      , Tr "b"+      , Tr "g"+      , Bl "a/one"+      , Tr "b/c"+      , Bl "b/c/two"+      , Tr "g/h"+      , Tr "g/h/i"+      , Tr "g/h/i/j"+      , Bl "g/h/i/j/four"+      ] $ do+          putBlob "a/one" =<< lift (createBlobUtf8 "one\n")+          putBlob "b/c/two" =<< lift (createBlobUtf8 "two\n")+          putBlob "b/c/three" =<< lift (createBlobUtf8 "three\n")+          putBlob "d/e/f/three" =<< lift (createBlobUtf8 "three\n")+          putBlob "g/h/i/j/four" =<< lift (createBlobUtf8 "four\n")+          putBlob "k/l/m/n/o/five" =<< lift (createBlobUtf8 "five\n")+          dropEntry "b/c/three"+          dropEntry "d/e/f/three"+          dropEntry "k/l"    where     fakeTime secs = utcToZonedTime utc (posixSecondsToUTCTime secs)++data Kind = Bl FilePath | Tr FilePath deriving (Eq, Show)++isBlobKind :: Kind -> Bool+isBlobKind (Bl _) = True+isBlobKind _      = False++kindPath :: Kind -> FilePath+kindPath (Bl path) = path+kindPath (Tr path) = path++data TreeitException = TreeitException T.Text deriving (Eq, Show, Typeable)++instance Exception TreeitException++mkBlob :: Repository m => FilePath -> TreeT m ()+mkBlob path =+    putBlob path =<< lift (createBlobUtf8 (baseFilename path <> "\n"))++baseFilename :: FilePath -> T.Text+baseFilename = either id id . toText . filename++doTreeit :: (MonadBaseControl IO m, MonadIO m,+             MonadTrans t, MonadGit (t m), Repository (t m))+       => String -> RepositoryFactory t m c -> [Kind] -> TreeT (t m) a -> m ()+doTreeit label pr kinds action = withNewRepository pr fullPath $ do+    tref <- createTree $ action+    tree <- resolveTreeRef tref+    forM_ kinds $ \kind -> do+        let path = kindPath kind+        entry <- getTreeEntry tree path+        case entry of+            Just (BlobEntry boid _) -> do+                liftIO $ isBlobKind kind @?= True+                bs <- lookupBlob boid >>= blobToByteString+                liftIO $ T.decodeUtf8 bs @?= baseFilename path <> "\n"+            Just (TreeEntry _) ->+                liftIO $ isBlobKind kind @?= False+            Nothing ->+                liftIO $ throwIO (TreeitException "Expected entry not found")+            _ -> do+                liftIO $ isBlobKind kind @?= False+                liftIO $ throwIO (TreeitException "Entry is of unexpected kind")+    kinds' <- traverseEntries (const . return) tree+    liftIO $ sort kinds' @?= map kindPath kinds+  where+    fullPath  = fromText (T.pack (normalize label)) <> ".git"+    normalize = map (\x -> if x == ' ' then '-' else x)++treeit :: (Example (m ()), MonadTrans t, MonadGit m,+           MonadGit (t m), Repository (t m))+       => String -> RepositoryFactory t m c -> [Kind] -> TreeT (t m) a -> Spec+treeit label pr kinds action = it label $ doTreeit label pr kinds action++treeitFail :: (MonadTrans t,+               MonadGit (t IO), Repository (t IO))+           => String -> RepositoryFactory t IO c -> [Kind] -> TreeT (t IO) a+           -> Spec+treeitFail label pr kinds action =+    it label $ doTreeit label pr kinds action+        `shouldThrow` (\(_ :: TreeitException) -> True)  -- Main.hs ends here

@@ -1,5 +1,5 @@ Name:                gitlib-test-Version:             1.2.0+Version:             1.3.1 Synopsis:            Test library for confirming gitlib backend compliance License-file:        LICENSE License:             MIT@@ -22,8 +22,8 @@ --     Hs-source-dirs: test --     Build-depends:  --           base >=3---         , gitlib               >= 1.1.0---         , gitlib-test          >= 1.1.0+--         , gitlib               >= 1.3.1+--         , gitlib-test          >= 1.3.1 --         , HUnit                >= 1.2.5 --         , SHA                  >= 1.4.0 --         , bytestring           >= 0.9.2.1@@ -43,15 +43,16 @@     ghc-options: -Wall     build-depends:           base                 >= 3 && < 5-        , gitlib               >= 1.1.0-        , gitlib-utils         >= 1.1.0+        , gitlib               >= 1.3.1         , HUnit                >= 1.2.5         , hspec                >= 1.4.4         , hspec-expectations   >= 0.3+        , bytestring           >= 0.9.2         , monad-control        >= 0.3.1         , system-fileio        >= 0.3.9         , system-filepath      >= 0.4.7         , tagged               >= 0.4.4+        , text                 >= 0.11.2         , time                 >= 1.4         , transformers         >= 0.3     exposed-modules: