{-# OPTIONS_GHC -F -pgmF htfpp #-} {-# LANGUAGE ScopedTypeVariables #-} module DPM.Core.TestDarcs ( allHTFTests ) where import Prelude hiding ( catch ) import Control.Monad ( when ) import System.Environment ( getArgs ) import Data.List ( find ) import System.FilePath import Control.Exception ( bracket_, catch, SomeException ) import Prelude hiding ( catch ) import Data.List ( isInfixOf, isPrefixOf ) import qualified Data.ByteString.Char8 as B import System.IO import Text.PrettyPrint import HSH import Test.Framework import DPM.Core.DataTypes ( Patch(..), unPatchGroupID, PatchData(..), unPatchID ) import DPM.Core.Darcs import DPM.Core.PatchBundleParser repoRoot :: FilePath repoRoot = "__repo__" withRepoRoot :: IO a -> IO a withRepoRoot = withTempDir repoRoot withTempDir :: FilePath -> IO a -> IO a withTempDir dir action = withTempDirNoCD dir (bracketCD dir action) withTempDirNoCD :: FilePath -> IO a -> IO a withTempDirNoCD dir action = bracket_ (do runIO ("rm", ["-rf", dir]) runIO ("mkdir", [dir])) (do runIO ("rm", ["-rf", dir]) `catch` \(e::SomeException) -> return ()) action setupRepos :: IO () setupRepos = do runIO "mkdir A B" bracketCD "A" $ mapM_ runIO ["darcs init" ,"echo 1 > x" ,"darcs add x" ,"darcs record --no-ask-deps -a -m 'Patch 0'"] bracketCD "B" $ mapM_ runIO ["darcs init" ,"darcs pull ../A -a" ,"echo 2 >> x" ,"echo 3 >> x" ,"echo 4 >> x" ,"echo 5 >> x" ,"echo anchor >> x" ,"echo anchor >> x" ,"echo anchor >> x" ,"echo 6 >> x" ,"echo 7 >> x" ,"darcs record --no-ask-deps -a -m 'Patch 1'" ,"echo 1 > x" ,"echo 22 >> x" ,"echo 3 >> x" ,"echo 4 >> x" ,"echo 5 >> x" ,"echo 5 >> x" ,"echo 5 >> x" ,"echo 5 >> x" ,"echo anchor >> x" ,"echo anchor >> x" ,"echo anchor >> x" ,"echo 42 >> x" ,"echo 7 >> x" ,"darcs record --no-ask-deps -a -m 'Patch 2'" ,"echo 4 > y" ,"darcs add y" ,"darcs record --no-ask-deps -a -m " ++ "'INDEPENDENT'" ,"darcs send --dont-edit-description -a -o ../bundle ../A"] test_ok = withRepoRoot $ do setupRepos bundle <- B.readFile "bundle" eith <- readPatchBundle "A" bundle content <- assertRight eith let patches = pbc_patches content assertEqual 3 (length patches) let patch1:patch2:patch3:[] = patches -- check patch 1 assertEqual "Patch 1" (unPatchGroupID (p_name patch1)) assertEmpty (p_dependents patch1) -- check patch 2 assertEqual "Patch 2" (unPatchGroupID (p_name patch2)) let deps2 = p_dependents patch2 assertEqual 1 (length deps2) assertEqual (p_id patch1) (head deps2) -- check patch 3 assertEqual "INDEPENDENT" (unPatchGroupID (p_name patch3)) assertEmpty (p_dependents patch3) -- check what happens if repo A already has all patches of the bundle test_allPatchesPresent = withRepoRoot $ do setupRepos bracketCD "A" $ runIO "darcs pull --all ../B" bundle <- B.readFile "bundle" eith <- readPatchBundle "A" bundle content <- assertRight eith let patches = pbc_patches content assertEmpty patches -- check what happens if repo A misses a patch in the context -- of the bundle test_missingPatch = withRepoRoot $ do setupRepos bracketCD "A" $ runIO "darcs unrecord --all" bundle <- B.readFile "bundle" eith <- readPatchBundle "A" bundle s <- assertLeft eith assertBool ("missing" `isInfixOf` s) -- check what happens if the patch bundle has a wrong hash test_wrongBundleHash = withRepoRoot $ do setupRepos s <- readFile "bundle" let l = lines s hash = head (reverse l) wrongHash = case hash of ('1':xs) -> '2':xs (_:xs) -> '1':xs _ -> [] l' = reverse (wrongHash : (tail (reverse l))) s' = unlines l' writeFile "bundle_wrong_hash" s' bundle <- B.readFile "bundle_wrong_hash" eith <- readPatchBundle "A" bundle s <- assertLeft eith assertBool ("Patch bundle failed hash" `isPrefixOf` s) -- check what happens if the patch bundle has an illegal format test_illegalBundleFormat = withRepoRoot $ do setupRepos eith <- readPatchBundle "A" (B.pack "I AM AN ILLEGAL PATCH BUNDLE") s <- assertLeft eith assertBool ("Bad patch bundle" `isPrefixOf` s) assertPatches :: [String] -> String -> IO () assertPatches patchNames changesOut = let patchNames' = map (drop 4) . filter (\s -> " * " `isPrefixOf` s) . lines $ changesOut in assertEqual patchNames patchNames' -- FIXME: test apply test_apply = withRepoRoot $ do setupRepos bundle <- B.readFile "bundle" eith <- readPatchBundle "A" bundle content <- assertRight eith let patches = pbc_patches content assertEqual 3 (length patches) let p1:p2:p3:[] = patches x <- apply "A" (text "Patch 1") (p_id p1) False False "bundle" assertRight x out1 <- run "darcs changes --repodir=A" assertPatches ["Patch 1", "Patch 0"] out1 y <- apply "A" (text "Patch 2") (p_id p2) False False "bundle" assertRight y out2 <- run "darcs changes --repodir=A" assertPatches ["Patch 2", "Patch 1", "Patch 0"] out2 z <- apply "A" (text "INDEPENDENT") (p_id p3) False False "bundle" assertRight z out3 <- run "darcs changes --repodir=A" assertPatches ["INDEPENDENT", "Patch 2", "Patch 1", "Patch 0"] out3 -- FIXME: test conflicts more seriously {- test_conflicts = withRepoRoot $ do runIO "mkdir A B C" bracketCD "A" $ mapM_ runIO ["darcs init" ,"echo 1 > x" ,"darcs add x" ,"darcs record -a -m 'Patch 0'"] mkRepo "B" mkRepo "C" bundleB <- B.readFile "bundleB" eithB <- readPatchBundle "A" bundleB [] contentB <- assertRight eithB let pidB = p_id $ head $ pbc_patches contentB assertEqual (pbc_conflicts contentB) [(pidB, [])] bundleC <- B.readFile "bundleC" eithC <- readPatchBundle "A" bundleC (pbc_data contentB) contentC <- assertRight eithC let pidC = p_id $ head $ pbc_patches contentC assertEqual (pbc_conflicts contentC) [(pidC, [pidB])] let getBS x = pd_content $ head $ pbc_data x bsB = getBS contentB bsC = getBS contentC repoConflictB <- bundleConflictsWithRepo "A" bsB assertEqual repoConflictB False repoConflictC <- bundleConflictsWithRepo "A" bsC assertEqual repoConflictC False -- after applying bundleB, C conflicts with the repo x <- apply "A" "bundleB" assertRight x repoConflictC <- bundleConflictsWithRepo "A" bsC assertEqual repoConflictC True where mkRepo dir = do bracketCD dir $ mapM_ runIO ["darcs init" ,"darcs pull ../A -a" ,"echo " ++ dir ++ " >> x" ,"darcs record -a -m 'Patch " ++ dir ++ "'" ,"darcs send -a -o " ++ "../bundle" ++ dir] -} test_patchBundleParser = do let bundleData = B.pack $ unlines testPatchBundleContent let eith = scanBundle bundleData infos <- assertRight eith assertEqual (length infos) 3 let (pi1,d1):(pi2,d2):(pi3,d3):[] = infos assertEqual pi1 (PatchInfo "20091203132005" "MINOR: Vitalwerte ueber Konfig (de-)aktivieren" "Dirk Spoeri " ["Ignore-this: 729a19332b2cfec7c18391234d505998"] False) assertEqual d1 (B.pack "{\nhunk11\nhunk12") assertEqual pi2 (PatchInfo "20100125162933" "FEATURE: bei Standalone neue Mobil-Mitarbeiter anlegen" "Dirk Spoeri " ["Ignore-this: 59a42d4317961478dfd3d731b5a3a95d"] False) assertEqual d2 (B.pack ("<\n" ++ "[TRIVIAL: 'versorgt durch' durch 'Versorgung durch'\n" ++ "Johannes Weiss **20071130173047]\n" ++ "> {\n" ++ "hunk21\n" ++ "hunk22")) assertEqual pi3 (PatchInfo "20091210101000" "MINOR: Merge-Konflikt Standalone<->Global editieren" "Dirk Spoeri " ["Ignore-this: 79ac83a1f24ca4835b9ad467498d5e30"] False) assertEqual d3 (B.pack "hunk31\nhunk32") testPatchBundleContent = ["", "", "New patches:", "", "[MINOR: Vitalwerte ueber Konfig (de-)aktivieren", "Dirk Spoeri **20091203132005", " Ignore-this: 729a19332b2cfec7c18391234d505998", "] {", "hunk11", "hunk12", "[FEATURE: bei Standalone neue Mobil-Mitarbeiter anlegen", "Dirk Spoeri **20100125162933", " Ignore-this: 59a42d4317961478dfd3d731b5a3a95d", "]", "<", "[TRIVIAL: 'versorgt durch' durch 'Versorgung durch'", "Johannes Weiss **20071130173047]", "> {", "hunk21", "hunk22", "[MINOR: Merge-Konflikt Standalone<->Global editieren", "Dirk Spoeri **20091210101000", " Ignore-this: 79ac83a1f24ca4835b9ad467498d5e30", "] hunk31", "hunk32", "", "Context:", "", "[TRIVIAL: Grammatikalischen Fehler gefixt", "Johannes Weiss **20100125142927", " Ignore-this: e9dcd96bf556f84979e69c13ab60010b", "", " Woerter bestehen aus Buchstaben, Worte bestehen aus Gedanken.", " vgl. http://www.spiegel.de/kultur/zwiebelfisch/0,1518,307445,00.html", "]"] test_encodingWrong = bracketCD "tests/encoding-problem" $ withTempDirNoCD "A" $ do bracketCD "A" (runIO "darcs init") bundle <- B.readFile "problem.dpatch" eith <- readPatchBundle "A" bundle content <- assertRight eith let patches = pbc_patches content assertEqual 2 (length patches) putStrLn (show patches)