%  Copyright (C) 2002-2005,2007 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; see the file COPYING.  If not, write to
%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
%  Boston, MA 02110-1301, USA.

\documentclass{report}
\usepackage{color}

\usepackage{verbatim}
\newenvironment{code}{\color{blue}\verbatim}{\endverbatim}

\begin{document}

% Definition of title page:
\title{
    Unit Testing for darcs in Haskell
}
\author{
    David Roundy    % insert author(s) here
}

\maketitle

\tableofcontents  % Table of Contents

\chapter{Introduction}

This is a unit testing program, which is intended to make sure that all the
functions of my darcs code work properly.

\begin{code}
{-# OPTIONS_GHC -cpp -fno-warn-orphans -fno-warn-deprecations -fglasgow-exts #-}
{-# LANGUAGE CPP #-}

module Darcs.Test.Unit (main) where

import System.IO.Unsafe ( unsafePerformIO )
import ByteStringUtils hiding ( intercalate )
import qualified Data.ByteString.Char8 as BC ( unpack, pack )
import qualified Data.ByteString as B ( concat, empty )
import Darcs.Patch
import Darcs.Test.Patch.Test
import Darcs.Test.Patch.Unit ( patchUnitTests )
import Darcs.Test.Email ( emailParsing, emailHeaderNoLongLines,
                          emailHeaderAsciiChars, emailHeaderLinesStart,
                          emailHeaderNoEmptyLines )
import Darcs.Test.Patch.Info ( metadataDecodingTest, metadataEncodingTest,
                               packUnpackTest )
import Lcs ( shiftBoundaries )
import Test.QuickCheck
import Printer ( renderPS )
import Darcs.Patch.Commute
import Data.Array.Base
import Data.Array.Unboxed
import Control.Monad.ST
import Darcs.Witnesses.Ordered
import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal )
import Test.HUnit ( assertBool, assertFailure )
import Test.Framework.Providers.QuickCheck2 ( testProperty )
import Test.Framework.Providers.HUnit ( testCase )
import Test.Framework.Runners.Console ( defaultMain )
import Test.Framework ( Test )

#include "impossible.h"
\end{code}

\chapter{Main body of code}

\begin{code}
main :: IO ()
main = do
    putStr ("There are a total of "++(show (length primitiveTestPatches))
            ++" primitive patches.\n")
    putStr ("There are a total of "++
            (show (length testPatches))++" patches.\n")
    defaultMain tests

-- | Utility function to run bools with test-framework
testBool :: String -> Bool -> Test
testBool name test = testCase name (assertBool assertName test)
  where assertName = "boolean test \"" ++ name ++ "\" should return True"

-- | Utility function to run old tests that return a list of error messages,
--   with the empty list meaning success.
testStringList :: String -> [String] -> Test
testStringList name test = testCase name $ mapM_ assertFailure test

-- | This is the big list of tests that will be run using testrunner.
tests :: [Test]
tests = patchUnitTests ++
        [testBool "Checking that UTF-8 packing and unpacking preserves 'hello world'"
                  (unpackPSFromUTF8 (BC.pack "hello world") == "hello world"),
         testBool "Checking that hex packing and unpacking preserves 'hello world'"
                  (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world")
                       == "hello world"),
         emailParsing,
         emailHeaderNoLongLines,
         emailHeaderAsciiChars,
         emailHeaderLinesStart,
         emailHeaderNoEmptyLines,
         testProperty "Checking that B.concat works" propConcatPS,
         testProperty "Checking that hex conversion works" propHexConversion,
         testProperty "Checking that show and read work right" propReadShow,
         testStringList "Checking known commutes" commuteTests,
         testStringList "Checking known merges" mergeTests,
         testStringList "Checking known canons" canonizationTests]
        ++ checkSubcommutes subcommutesInverse "patch and inverse both commute"
        ++ checkSubcommutes subcommutesNontrivialInverse "nontrivial commutes are correct"
        ++ checkSubcommutes subcommutesFailure "inverses fail"
        ++
        [testProperty "Checking that commuting by patch and its inverse is ok" propCommuteInverse,
         --putStr "Checking that conflict resolution is valid... "
         --runQuickCheckTest returnval propResolveConflictsValid
         testProperty "Checking that a patch followed by its inverse is identity" propPatchAndInverseIsIdentity,
         -- The following tests are "wrong" with the Conflictor code.
         --putStr "Checking that a simple smart_merge is sufficient... "
         --runQuickCheckTest returnval propSimpleSmartMergeGoodEnough
         --putStr "Checking that an elegant merge is sufficient... "
         --runQuickCheckTest returnval propElegantMergeGoodEnough
         testProperty "Checking that commutes are equivalent" propCommuteEquivalency,
         testProperty "Checking that merges are valid" propMergeValid,
         testProperty "Checking inverses being valid" propInverseValid,
         testProperty "Checking other inverse being valid" propOtherInverseValid,
         testStringList "Checking merge swaps" mergeSwapTests,
         -- The patch generator isn't smart enough to generate correct test
         -- cases for the following: (which will be obsoleted soon, anyhow)
         --putStr "Checking the order dependence of unravel... "
         --runQuickCheckTest returnval propUnravelOrderIndependent
         --putStr "Checking the unravelling of three merges... "
         --runQuickCheckTest returnval propUnravelThreeMerge
         --putStr "Checking the unravelling of a merge of a sequence... "
         --runQuickCheckTest returnval propUnravelSeqMerge
         testProperty "Checking inverse of inverse" propInverseComposition,
         testProperty "Checking the order of commutes" propCommuteEitherOrder,
         testProperty "Checking commute either way" propCommuteEitherWay,
         testProperty "Checking the double commute" propCommuteTwice,
         testProperty "Checking that merges commute and are well behaved" propMergeIsCommutableAndCorrect,
         testProperty "Checking that merges can be swapped" propMergeIsSwapable,
         testProperty "Checking again that merges can be swapped (I'm paranoid) " propMergeIsSwapable,
         testStringList "Checking that the patch validation works" testCheck,
         testStringList "Checking commute/recommute" commuteRecommuteTests,
         testStringList "Checking merge properties" genericMergeTests,
         testStringList "Testing the lcs code" showLcsTests,
         testStringList "Checking primitive patch IO functions" primitiveShowReadTests,
         testStringList "Checking IO functions" showReadTests,
         testStringList "Checking primitive commute/recommute" primitiveCommuteRecommuteTests,
         metadataDecodingTest,
         metadataEncodingTest,
         packUnpackTest
        ]
\end{code}

\chapter{Unit Tester}

The unit tester function is really just a glorified map for functions that
return lists, in which the lists get concatenated (where map would end up
with a list of lists).

\begin{code}
type PatchUnitTest p = p -> [String]
type TwoPatchUnitTest = Patch -> Patch -> [String]

parallelPairUnitTester :: TwoPatchUnitTest -> [(Patch:\/:Patch)] -> [String]
parallelPairUnitTester _ []        = []
parallelPairUnitTester thetest ((p1:\/:p2):ps)
    = (thetest p1 p2)++(parallelPairUnitTester thetest ps)

pairUnitTester :: TwoPatchUnitTest -> [(Patch:<Patch)] -> [String]
pairUnitTester _ []        = []
pairUnitTester thetest ((p1:<p2):ps)
    = (thetest p1 p2)++(pairUnitTester thetest ps)
\end{code}

\chapter{LCS}

Here are a few quick tests of the shiftBoundaries function.

\begin{code}
showLcsTests :: [String]
showLcsTests = concatMap checkKnownShifts knownShifts
checkKnownShifts :: ([Int],[Int],String,String,[Int],[Int])
                   -> [String]
checkKnownShifts (ca, cb, sa, sb, ca', cb') = runST (
    do ca_arr <- newListArray (0, length ca) $ toBool (0:ca)
       cb_arr <- newListArray (0, length cb) $ toBool (0:cb)
       let p_a = listArray (0, length sa) $ B.empty:(toPS sa)
           p_b = listArray (0, length sb) $ B.empty:(toPS sb)
       shiftBoundaries ca_arr cb_arr p_a 1 1
       shiftBoundaries cb_arr ca_arr p_b 1 1
       ca_res <- fmap (fromBool . tail) $ getElems ca_arr
       cb_res <- fmap (fromBool . tail) $ getElems cb_arr
       return $ if ca_res  == ca' && cb_res == cb' then []
                else ["shiftBoundaries failed on "++sa++" and "++sb++" with "
                      ++(show (ca,cb))++" expected "++(show (ca', cb'))
                      ++" got "++(show (ca_res, cb_res))++"\n"])
 where toPS = map (\c -> if c == ' ' then B.empty else BC.pack [c])
       toBool = map (>0)
       fromBool = map (\b -> if b then 1 else 0)

knownShifts :: [([Int],[Int],String,String,[Int],[Int])]
knownShifts =
  [([0,0,0],[0,1,0,1,0],"aaa","aaaaa",
    [0,0,0],[0,0,0,1,1]),
   ([0,1,0],[0,1,1,0],"cd ","c a ",
    [0,1,0],[0,1,1,0]),
   ([1,0,0,0,0,0,0,0,0],[1,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","dg{} ih{} if{}",
    [1,0,0,0,0,0,0,0,0],[1,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end
   ([0,0,0,0,0,0,0,0,0],[0,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","fg{} ih{} if{}",
    [0,0,0,0,0,0,0,0,0],[0,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end
   ([],[1,1],"","aa",[],[1,1]),
   ([1,1],[],"aa","",[1,1],[])]


\end{code}

\chapter{Show/Read tests}

This test involves calling ``show'' to print a string describing a patch,
and then using readPatch to read it back in, and making sure the patch we
read in is the same as the original.  Useful for making sure that I don't
have any stupid IO bugs.

\begin{code}
showReadTests :: [String]
showReadTests = concatMap tShowRead testPatches ++
                  concatMap tShowRead testPatchesNamed
primitiveShowReadTests :: [String]
primitiveShowReadTests = concatMap tShowRead primitiveTestPatches
tShowRead :: (Eq p, Show p, Patchy p) => PatchUnitTest p
tShowRead p =
    case readPatch $ renderPS $ showPatch p of
    Just (Sealed p',_) -> if p' == p then []
                          else ["Failed to read shown:  "++(show p)++"\n"]
    Nothing -> ["Failed to read at all:  "++(show p)++"\n"]

instance MyEq p => Eq (Named p) where
    (==) = unsafeCompare
\end{code}

\chapter{Canonization tests}

This is a set of known correct canonizations, to make sure that I'm
canonizing as I ought.

\begin{code}
canonizationTests :: [String]
canonizationTests = concatMap checkKnownCanon knownCanons
checkKnownCanon :: (Patch, Patch) -> [String]
checkKnownCanon (p1,p2) =
    if (fromPrims $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1) == p2
    then []
    else ["Canonization failed:\n"++show p1++"canonized is\n"
          ++show (fromPrims $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1 :: Patch)
          ++"which is not\n"++show p2]
knownCanons :: [(Patch,Patch)]
knownCanons =
    [(quickhunk 1 "abcde" "ab",  quickhunk 3 "cde"   ""),
     (quickhunk 1 "abcde" "bd", join_patches [quickhunk 1 "a" "",
                                              quickhunk 2 "c" "",
                                              quickhunk 3 "e" ""]),
     (join_patches [quickhunk 4 "a" "b",
                    quickhunk 1 "c" "d"],
      join_patches [quickhunk 1 "c" "d",
                    quickhunk 4 "a" "b"]),
     (join_patches [quickhunk 1 "a" "",
                    quickhunk 1 "" "b"],
      quickhunk 1 "a" "b"),
     (join_patches [quickhunk 1 "ab" "c",
                    quickhunk 1 "cd" "e"],
      quickhunk 1 "abd" "e"),
     (quickhunk 1 "abcde" "cde", quickhunk 1 "ab" ""),
     (quickhunk 1 "abcde" "acde", quickhunk 2 "b" "")]
quickhunk :: Int -> String -> String -> Patch
quickhunk l o n = fromPrim $ hunk "test" l (map (\c -> BC.pack [c]) o)
                                             (map (\c -> BC.pack [c]) n)
\end{code}

\chapter{Merge/unmgerge tests}

It should always be true that if two patches can be unmerged, then merging
the resulting patches should give them back again.
\begin{code}
genericMergeTests :: [String]
genericMergeTests =
  case take 400 [(p1:\/:p2)|
                 i <- [0..(length testPatches)-1],
                 p1<-[testPatches!!i],
                 p2<-drop i testPatches,
                 checkAPatch $ join_patches [invert p2,p1]] of
  merge_pairs -> (parallelPairUnitTester tMergeEitherWayValid merge_pairs) ++
                 (parallelPairUnitTester tMergeSwapMerge merge_pairs)
tMergeEitherWayValid   :: TwoPatchUnitTest
tMergeEitherWayValid p1 p2 =
  case join_patches [p2, quickmerge (p1:\/: p2)] of
  combo2 ->
    case join_patches [p1, quickmerge (p2:\/: p1)] of
    combo1 ->
      if not $ checkAPatch $ join_patches [combo1]
      then ["oh my combo1 invalid:\n"++show p1++"and...\n"++show p2++show combo1]
      else
        if checkAPatch $ join_patches [invert combo1, combo2]
        then []
        else ["merge both ways invalid:\n"++show p1++"and...\n"++show p2++
              show combo1++
              show combo2]
tMergeSwapMerge   :: TwoPatchUnitTest
tMergeSwapMerge p1 p2 =
  if (swapp $ merge (p2:\/: p1)) == merge (p1:\/:p2)
  then []
  else ["Failed to swap merges:\n"++show p1++"and...\n"++show p2
        ++"merged:\n"++show (merge (p1:\/:p2))++"\n"
        ++"merged and swapped:\n"++show (swapp $ merge (p2:\/: p1))++"\n"]
    where swapp (x :/\: y) = y :/\: x

instance Show p => Show (p :/\: p) where
   show (x :/\: y) = show x ++ " :/\\: " ++ show y
instance Eq p => Eq (p :/\: p) where
   (x :/\: y) == (x' :/\: y') = x == x' && y == y'
\end{code}

\chapter{Commute/recommute tests}

Here we test to see if commuting patch A and patch B and then commuting the
result gives us patch A and patch B again.  The set of patches (A,B) is
chosen from the set of all pairs of test patches by selecting those which
commute with one another.

\begin{code}
commuteRecommuteTests :: [String]
commuteRecommuteTests =
  case take 200 [(p2:<p1)|
                 p1<-testPatches,
                 p2<-filter (\p->checkseq [p1,p]) testPatches,
                 commute (p1:>p2) /= Nothing] of
  commute_pairs -> pairUnitTester tCommuteRecommute commute_pairs
  where checkseq ps = checkAPatch $ join_patches ps
primitiveCommuteRecommuteTests :: [String]
primitiveCommuteRecommuteTests =
  pairUnitTester tCommuteRecommute
    [(p1:<p2)|
     p1<-primitiveTestPatches,
     p2<-primitiveTestPatches,
     commute (p2:>p1) /= Nothing,
     checkAPatch $ join_patches [p2,p1]]
tCommuteRecommute   :: TwoPatchUnitTest
tCommuteRecommute p1 p2 =
    if (commute (p2:>p1) >>= commute) == Just (p2:>p1)
       then []
       else ["Failed to recommute:\n"++(show p2)++(show p1)++
            "we saw it as:\n"++show (commute (p2:>p1))++
             "\nAnd recommute was:\n"++show (commute (p2:>p1) >>= commute)
             ++ "\n"]
\end{code}

\chapter{Commute tests}

Here we provide a set of known interesting commutes.
\begin{code}
commuteTests :: [String]
commuteTests =
    concatMap checkKnownCommute knownCommutes++
    concatMap checkCantCommute knownCantCommute
checkKnownCommute :: (Patch:< Patch, Patch:< Patch) -> [String]
checkKnownCommute (p1:<p2,p2':<p1') =
   case commute (p2:>p1) of
   Just (p1a:>p2a) ->
       if (p2a:< p1a) == (p2':< p1')
       then []
       else ["Commute gave wrong value!\n"++show p1++"\n"++show p2
             ++"should be\n"++show p2'++"\n"++show p1'
             ++"but is\n"++show p2a++"\n"++show p1a]
   Nothing -> ["Commute failed!\n"++show p1++"\n"++show p2]
   ++
   case commute (p1':>p2') of
   Just (p2a:>p1a) ->
       if (p1a:< p2a) == (p1:< p2)
       then []
       else ["Commute gave wrong value!\n"++show p2a++"\n"++show p1a
             ++"should have been\n"++show p2'++"\n"++show p1']
   Nothing -> ["Commute failed!\n"++show p2'++"\n"++show p1']
knownCommutes :: [(Patch:<Patch,Patch:<Patch)]
knownCommutes = [
                  (testhunk 1 [] ["A"]:<
                   testhunk 2 [] ["B"],
                   testhunk 3 [] ["B"]:<
                   testhunk 1 [] ["A"]),
                  (fromPrim (tokreplace "test" "A-Za-z_" "old" "new"):<
                   testhunk 2
                   ["hello world all that is old is good old_"]
                   ["I don't like old things"],
                   testhunk 2
                   ["hello world all that is new is good old_"]
                   ["I don't like new things"]:<
                   fromPrim (tokreplace "test" "A-Za-z_" "old" "new")),
                  (testhunk 1 ["A"] ["B"]:<
                   testhunk 2 ["C"] ["D"],
                   testhunk 2 ["C"] ["D"]:<
                   testhunk 1 ["A"] ["B"]),
                  (fromPrim (rmfile "NwNSO"):<
                   (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))),
                   (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))):<
                   fromPrim (rmfile "NwNSO")),

                  (quickmerge (testhunk 3 ["o"] ["n"]:\/:
                               testhunk 3 ["o"] ["v"]):<
                   testhunk 1 [] ["a"],
                   testhunk 1 [] ["a"]:<
                   quickmerge (testhunk 2 ["o"] ["n"]:\/:
                               testhunk 2 ["o"] ["v"])),

                  (testhunk 1 ["A"] []:<
                   testhunk 3 ["B"] [],
                   testhunk 2 ["B"] []:<
                   testhunk 1 ["A"] []),

                  (testhunk 1 ["A"] ["B"]:<
                   testhunk 2 ["B"] ["C"],
                   testhunk 2 ["B"] ["C"]:<
                   testhunk 1 ["A"] ["B"]),

                  (testhunk 1 ["A"] ["B"]:<
                   testhunk 3 ["B"] ["C"],
                   testhunk 3 ["B"] ["C"]:<
                   testhunk 1 ["A"] ["B"]),

                  (testhunk 1 ["A"] ["B","C"]:<
                   testhunk 2 ["B"] ["C","D"],
                   testhunk 3 ["B"] ["C","D"]:<
                   testhunk 1 ["A"] ["B","C"])]
  where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)

checkCantCommute :: (Patch:< Patch) -> [String]
checkCantCommute (p1:<p2) =
    case commute (p2:>p1) of
    Nothing -> []
    _ -> [show p1 ++ "\n\n" ++ show p2 ++
          "\nArgh, these guys shouldn't commute!\n"]
knownCantCommute :: [(Patch:< Patch)]
knownCantCommute = [
                      (testhunk 2 ["o"] ["n"]:<
                       testhunk 1 [] ["A"]),
                      (testhunk 1 [] ["A"]:<
                       testhunk 1 ["o"] ["n"]),
                      (quickmerge (testhunk 2 ["o"] ["n"]:\/:
                                   testhunk 2 ["o"] ["v"]):<
                       testhunk 1 [] ["a"]),
                      (fromPrim (hunk "test" 1 ([BC.pack "a"]) ([BC.pack "b"])):<
                       fromPrim (addfile "test"))]
  where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)
\end{code}

\chapter{Merge tests}

Here we provide a set of known interesting merges.
\begin{code}
mergeTests :: [String]
mergeTests =
    concatMap checkKnownMergeEquiv knownMergeEquivs++
    concatMap checkKnownMerge knownMerges
checkKnownMerge :: (Patch:\/: Patch, Patch) -> [String]
checkKnownMerge (p1:\/:p2,p1') =
   case merge (p1:\/:p2) of
   _ :/\: p1a ->
       if p1a == p1'
       then []
       else ["Merge gave wrong value!\n"++show p1++show p2
             ++"I expected\n"++show p1'
             ++"but found instead\n"++show p1a]
knownMerges :: [(Patch:\/:Patch,Patch)]
knownMerges = [
                (testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"]:\/:
                 testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"],
                 testhunk 3 [BC.pack "c"] [BC.pack "d",BC.pack "e"]),
                (testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]:\/:
                 testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"],
                 testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]),
                (testhunk 3 [BC.pack "A"] []:\/:
                 testhunk 1 [BC.pack "B"] [],
                 testhunk 2 [BC.pack "A"] []),
                (fromPrim (rmdir "./test/world"):\/:
                 fromPrim (hunk "./world" 3 [BC.pack "A"] []),
                 fromPrim (rmdir "./test/world")),

                (join_patches [quickhunk 1 "a" "bc",
                               quickhunk 6 "d" "ef"]:\/:
                 join_patches [quickhunk 3 "a" "bc",
                               quickhunk 8 "d" "ef"],
                 join_patches [quickhunk 1 "a" "bc",
                               quickhunk 7 "d" "ef"]),

                (testhunk 1 [BC.pack "A"] [BC.pack "B"]:\/:
                 testhunk 2 [BC.pack "B"] [BC.pack "C"],
                 testhunk 1 [BC.pack "A"] [BC.pack "B"]),

                (testhunk 2 [BC.pack "A"] [BC.pack "B",BC.pack "C"]:\/:
                 testhunk 1 [BC.pack "B"] [BC.pack "C",BC.pack "D"],
                 testhunk 3 [BC.pack "A"] [BC.pack "B",BC.pack "C"])]
  where testhunk l o n = fromPrim $ hunk "test" l o n
checkKnownMergeEquiv :: (Patch:\/:Patch,Patch) -> [String]
checkKnownMergeEquiv (p1:\/: p2, pe) =
    case quickmerge (p1:\/:p2) of
    p1' -> if checkAPatch $ join_patches [invert p1, p2, p1', invert pe]
           then []
           else ["Oh no, merger isn't equivalent...\n"++show p1++"\n"++show p2
                 ++"in other words\n" ++ show (p1 :\/: p2)
                 ++"merges as\n" ++ show (merge $ p1 :\/: p2)
                 ++"merges to\n" ++ show (quickmerge $ p1 :\/: p2)
                 ++"which is equivalent to\n" ++ show (effect p1')
                 ++ "should all work out to\n"
                 ++ show pe]
knownMergeEquivs :: [(Patch:\/: Patch, Patch)]
knownMergeEquivs = [

                     -- The following tests are going to be failed by the
                     -- Conflictor code as a cleanup.

                     --(addfile "test":\/:
                     -- adddir "test",
                     -- join_patches [adddir "test",
                     --               addfile "test-conflict"]),
                     --(move "silly" "test":\/:
                     -- adddir "test",
                     -- join_patches [adddir "test",
                     --               move "silly" "test-conflict"]),
                     --(addfile "test":\/:
                     -- move "old" "test",
                     -- join_patches [addfile "test",
                     --               move "old" "test-conflict"]),
                     --(move "a" "test":\/:
                     -- move "old" "test",
                     -- join_patches [move "a" "test",
                     --               move "old" "test-conflict"]),
                     (fromPrim (hunk "test" 1 [] [BC.pack "A"]):\/:
                      fromPrim (hunk "test" 1 [] [BC.pack "B"]),
                      fromPrim (hunk "test" 1 [] [BC.pack "A", BC.pack "B"])),
                     (fromPrim (hunk "test" 1 [] [BC.pack "a"]):\/:
                      fromPrim (hunk "test" 1 [BC.pack "b"] []),
                      identity),
                      --hunk "test" 1 [] [BC.pack "v v v v v v v",
                      --                  BC.pack "*************",
                      --                  BC.pack "a",
                      --                  BC.pack "b",
                      --                  BC.pack "^ ^ ^ ^ ^ ^ ^"]),
                     (quickhunk 4 "a"  "":\/:
                      quickhunk 3 "a"  "",
                      quickhunk 3 "aa" ""),
                     (join_patches [quickhunk 1 "a" "bc",
                                    quickhunk 6 "d" "ef"]:\/:
                      join_patches [quickhunk 3 "a" "bc",
                                    quickhunk 8 "d" "ef"],
                      join_patches [quickhunk 3 "a" "bc",
                                    quickhunk 8 "d" "ef",
                                    quickhunk 1 "a" "bc",
                                    quickhunk 7 "d" "ef"]),
                     (quickmerge (quickhunk 2 "" "bd":\/:quickhunk 2 "" "a"):\/:
                              quickmerge (quickhunk 2 "" "c":\/:quickhunk 2 "" "a"),
                              quickhunk 2 "" "abdc")
                     ]
\end{code}

It also is useful to verify that it doesn't matter which order we specify
the patches when we merge.

\begin{code}
mergeSwapTests :: [String]
mergeSwapTests =
    concat
              [checkMergeSwap p1 p2 |
               p1<-primitiveTestPatches,
               p2<-primitiveTestPatches,
               checkAPatch $ join_patches [invert p1,p2]
              ]
checkMergeSwap :: Patch -> Patch -> [String]
checkMergeSwap p1 p2 =
    case merge (p2:\/:p1) of
    _ :/\: p2' ->
        case merge (p1:\/:p2) of
        _ :/\: p1' ->
            case commute (p1:>p2') of
            Just (_:>p1'b) ->
                if p1'b /= p1'
                then ["Merge swapping problem with...\np1 "++
                      show p1++"merged with\np2 "++
                      show p2++"p1' is\np1' "++
                      show p1'++"p1'b is\np1'b  "++
                      show p1'b
                     ]
                else []
            Nothing -> ["Merge commuting problem with...\np1 "++
                        show p1++"merged with\np2 "++
                        show p2++"gives\np2' "++
                        show p2'++"which doesn't commute with p1.\n"
                       ]
\end{code}

\chapter{Patch test data}

This is where we define the set of patches which we run our tests on.  This
should be kept up to date with as many interesting permutations of patch
types as possible.

\begin{code}
testPatches :: [Patch]
testPatchesNamed :: [Named Patch]
testPatchesAddfile :: [Patch]
testPatchesRmfile :: [Patch]
testPatchesHunk :: [Patch]
primitiveTestPatches :: [Patch]
testPatchesBinary :: [Patch]
testPatchesCompositeNocom :: [Patch]
testPatchesComposite :: [Patch]
testPatchesTwoCompositeHunks :: [Patch]
testPatchesCompositeHunks :: [Patch]
testPatchesCompositeFourHunks :: [Patch]
testPatchesMerged :: [Patch]
validPatches :: [Patch]

testPatchesNamed = [unsafePerformIO $
                      namepatch "date is" "patch name" "David Roundy" []
                                (fromPrim $ addfile "test"),
                      unsafePerformIO $
                      namepatch "Sat Oct 19 08:31:13 EDT 2002"
                                "This is another patch" "David Roundy"
                                ["This log file has","two lines in it"]
                                (fromPrim $ rmfile "test")]
testPatchesAddfile = map fromPrim
                       [addfile "test",adddir "test",addfile "test/test"]
testPatchesRmfile = map invert testPatchesAddfile
testPatchesHunk  =
    [fromPrim $ hunk file line old new |
     file <- ["test"],
     line <- [1,2],
     old <- map (map BC.pack) partials,
     new <- map (map BC.pack) partials,
     old /= new
    ]
    where partials  = [["A"],["B"],[],["B","B2"]]

primitiveTestPatches = testPatchesAddfile ++
                         testPatchesRmfile ++
                         testPatchesHunk ++
                         [unsafeUnseal.fst.fromJust.readPatch $
                          BC.pack "move ./test/test ./hello",
                          unsafeUnseal.fst.fromJust.readPatch $
                          BC.pack "move ./test ./hello"] ++
                         testPatchesBinary

testPatchesBinary =
    [fromPrim $ binary "./hello"
     (BC.pack $ "agadshhdhdsa75745457574asdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg")
     (BC.pack $ "adafjttkykrehhtrththrthrthre" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaasdgg" ++
      "a326424677373735753246463gadshhdhdsaagg"),
     fromPrim $ binary "./hello"
     B.empty
     (BC.pack "adafjttkykrere")]

testPatchesCompositeNocom =
    take 50 [join_patches [p1,p2]|
             p1<-primitiveTestPatches,
             p2<-filter (\p->checkseq [p1,p]) primitiveTestPatches,
             commute (p1:>p2) == Nothing]
    where checkseq ps = checkAPatch $ join_patches ps

testPatchesComposite =
    take 100 [join_patches [p1,p2]|
              p1<-primitiveTestPatches,
              p2<-filter (\p->checkseq [p1,p]) primitiveTestPatches,
              commute (p1:>p2) /= Nothing,
              commute (p1:>p2) /= Just (p2:>p1)]
    where checkseq ps = checkAPatch $ join_patches ps

testPatchesTwoCompositeHunks =
    take 100 [join_patches [p1,p2]|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkseq [p1,p]) testPatchesHunk]
    where checkseq ps = checkAPatch $ join_patches ps

testPatchesCompositeHunks =
    take 100 [join_patches [p1,p2,p3]|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkseq [p1,p]) testPatchesHunk,
              p3<-filter (\p->checkseq [p1,p2,p]) testPatchesHunk]
    where checkseq ps = checkAPatch $ join_patches ps

testPatchesCompositeFourHunks =
    take 100 [join_patches [p1,p2,p3,p4]|
              p1<-testPatchesHunk,
              p2<-filter (\p->checkseq [p1,p]) testPatchesHunk,
              p3<-filter (\p->checkseq [p1,p2,p]) testPatchesHunk,
              p4<-filter (\p->checkseq [p1,p2,p3,p]) testPatchesHunk]
    where checkseq ps = checkAPatch $ join_patches ps

testPatchesMerged =
  take 200
    [joinPatches $ flattenFL p2+>+flattenFL (quickmerge (p1:\/:p2)) |
     p1<-take 10 (drop 15 testPatchesCompositeHunks)++primitiveTestPatches
         ++take 10 (drop 15 testPatchesTwoCompositeHunks)
         ++ take 2 (drop 4 testPatchesCompositeFourHunks),
     p2<-take 10 testPatchesCompositeHunks++primitiveTestPatches
         ++take 10 testPatchesTwoCompositeHunks
         ++take 2 testPatchesCompositeFourHunks,
     checkAPatch $ join_patches [invert p1, p2],
     commute (p2:>p1) /= Just (p1:>p2)
    ]

testPatches =  primitiveTestPatches ++
                testPatchesComposite ++
                testPatchesCompositeNocom ++
                testPatchesMerged
\end{code}

\chapter{Check patch test}
Check patch is supposed to verify that a patch is valid.

\begin{code}
validPatches = [(join_patches [quickhunk 4 "a" "b",
                                quickhunk 1 "c" "d"]),
                 (join_patches [quickhunk 1 "a" "bc",
                                quickhunk 1 "b" "d"]),
                 (join_patches [quickhunk 1 "a" "b",
                                quickhunk 1 "b" "d"])]++testPatches

testCheck :: [String]
testCheck = concatMap tTestCheck validPatches
tTestCheck :: PatchUnitTest Patch
tTestCheck p = if checkAPatch p
                 then []
                 else ["Failed the check:  "++show p++"\n"]

propHexConversion :: String -> Bool
propHexConversion s =
    fromHex2PS (fromPS2Hex $ BC.pack s) == BC.pack s
propConcatPS :: [String] -> Bool
propConcatPS ss = concat ss == BC.unpack (B.concat $ map BC.pack ss)

-- | Groups a set of tests by giving them the same prefix in their description.
--   When this is called as @checkSubcommutes subcoms expl@, the prefix for a
--   test becomes @"Checking " ++ expl ++ " for subcommute "@.
checkSubcommutes :: Testable a => [(String, a)] -> String
                                                 -> [Test]
checkSubcommutes subcoms expl = map check_subcommute subcoms
  where check_subcommute (name, test) =
            let testName = "Checking" ++ expl ++ " for subcommute " ++ name
            in testProperty testName test
\end{code}

\end{document}