%  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 Main (main) where

import Control.Monad (when)
import System.IO.Unsafe ( unsafePerformIO )
import ByteStringUtils
import qualified Data.ByteString.Char8 as BC ( unpack, pack )
import qualified Data.ByteString as B ( empty, concat )
import Darcs.Patch
import Darcs.Patch.Test
import Darcs.Patch.Unit ( run_patch_unit_tests )
import Lcs ( shiftBoundaries )
import Test.QuickCheck
import System ( ExitCode(..), exitWith )
import System.IO ( hSetBuffering, stdout, BufferMode(..) )
import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )
import Printer ( renderPS, text )
import Darcs.Patch.Commute
import Data.Array.Base
import Data.Array.Unboxed
import Control.Monad.ST
import Darcs.Ordered
import Darcs.Sealed ( Sealed(Sealed), unsafeUnseal )

import Darcs.Email ( make_email, read_email )
#include "impossible.h"
\end{code}

\chapter{Main body of code}

\begin{code}
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  returnval <- newIORef 0
  patch_failures <- run_patch_unit_tests
  if patch_failures > 0
      then do putStrLn $ show patch_failures ++ " failures in Darcs.Patch.Unit."
              exitWith $ ExitFailure 1
      else putStrLn "No failures in Darcs.Patch.Unit."
  when (unpackPSfromUTF8 (BC.pack "hello world") /= "hello world") $
       do putStr "Problem with unpackPSfromUTF8\n"
          putStr $ "hello world isn't '" ++
                 unpackPSfromUTF8 (BC.pack "hello world")++"'\n"
          exitWith $ ExitFailure 1
  when (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world")
        /= "hello world") $
       do putStr "Problem with binary to hex conversion and back again\n"
          exitWith $ ExitFailure 1
  putStr "Checking that email can be parsed... "
  quickCheck $ \s ->
      unlines ("":s++["", ""]) ==
              BC.unpack (read_email (renderPS
                       $ make_email "reponame" [] (Just (text "contents\n"))
                       (text $ unlines s) (Just "filename")))
  --putStr $ test_patch
  --exitWith ExitSuccess
  case run_tests returnval of
    run -> do
      putStr ("There are a total of "++(show (length primitive_test_patches))
              ++" primitive patches.\n")
      putStr ("There are a total of "++
              (show (length test_patches))++" patches.\n")
      putStr "Checking that B.concat works... "
      quickCheck prop_concatPS
      putStr "Checking that hex conversion works... "
      quickCheck prop_hex_conversion
      putStr "Checking that show and read work right... "
      quickCheck prop_read_show
      run "Checking known commutes... " commute_tests
      run "Checking known merges... " merge_tests
      run "Checking known canons... " canonization_tests
      check_subcommutes subcommutes_inverse "patch and inverse both commutex"
      check_subcommutes subcommutes_nontrivial_inverse
                            "nontrivial commutes are correct"
      check_subcommutes subcommutes_failure "inverses fail"
      putStr "Checking that commuting by patch and its inverse is ok... "
      quickCheck prop_commute_inverse
      --putStr "Checking that conflict resolution is valid... "
      --quickCheck prop_resolve_conflicts_valid
      putStr "Checking that a patch followed by its inverse is identity... "
      quickCheck prop_patch_and_inverse_is_identity
      -- The following tests are "wrong" with the Conflictor code.
      --putStr "Checking that a simple smart_merge is sufficient... "
      --quickCheck prop_simple_smart_merge_good_enough
      --putStr "Checking that an elegant merge is sufficient... "
      --quickCheck prop_elegant_merge_good_enough
      putStr "Checking that commutes are equivalent... "
      quickCheck prop_commute_equivalency
      putStr "Checking that merges are valid... "
      quickCheck prop_merge_valid
      putStr "Checking inverses being valid... "
      quickCheck prop_inverse_valid
      putStr "Checking other inverse being valid... "
      quickCheck prop_other_inverse_valid
      run "Checking merge swaps... " merge_swap_tests
      -- 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... "
      --quickCheck prop_unravel_order_independent
      --putStr "Checking the unravelling of three merges... "
      --quickCheck prop_unravel_three_merge
      --putStr "Checking the unravelling of a merge of a sequence... "
      --quickCheck prop_unravel_seq_merge
      putStr "Checking inverse of inverse... "
      quickCheck prop_inverse_composition
      putStr "Checking the order of commutes... "
      quickCheck prop_commute_either_order
      putStr "Checking commutex either way... "
      quickCheck prop_commute_either_way
      putStr "Checking the double commutex... "
      quickCheck prop_commute_twice
      putStr "Checking that merges commutex and are well behaved... "
      quickCheck prop_merge_is_commutable_and_correct
      putStr "Checking that merges can be swapped... "
      quickCheck prop_merge_is_swapable
      putStr "Checking again that merges can be swapped (I'm paranoid) ... "
      quickCheck prop_merge_is_swapable
      run "Checking that the patch validation works... " test_check
      run "Checking commutex/recommute... " commute_recommute_tests
      run "Checking merge properties... " generic_merge_tests
      run "Testing the lcs code... " show_lcs_tests
      run "Checking primitive patch IO functions... " primitive_show_read_tests
      run "Checking IO functions... " show_read_tests
      run "Checking primitive commutex/recommute... "
          primitive_commute_recommute_tests
      trv <- readIORef returnval
      if trv == 0
         then exitWith ExitSuccess
         else exitWith $ ExitFailure trv
\end{code}

\section{run\_tests}

run\_tests is used to run a series of tests (which return a list of strings
describing their failures) and then update n IORef so the program can exit
with an error if one of the tests failed.

\begin{code}
run_tests :: (IORef Int) -> String -> [String] -> IO ()
run_tests return_val s ss = do
    putStr s
    if null ss
       then putStr "good.\n"
       else do modifyIORef return_val (+1)
               print_strings ss
               exitWith $ ExitFailure 1

print_strings :: [String] -> IO ()
print_strings [] = return ()
print_strings (s:ss) = do
  putStr s
  print_strings ss
\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]
unit_tester :: PatchUnitTest p -> [p] -> [String]
unit_tester _ []        = []
unit_tester thetest (p:ps) = (thetest p)++(unit_tester thetest ps)

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

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

\chapter{LCS}

Here are a few quick tests of the shiftBoundaries function.

\begin{code}
show_lcs_tests :: [String]
show_lcs_tests = concatMap check_known_shifts known_shifts
check_known_shifts :: ([Int],[Int],String,String,[Int],[Int])
                   -> [String] 
check_known_shifts (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)

known_shifts :: [([Int],[Int],String,String,[Int],[Int])]
known_shifts =
  [([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}
show_read_tests :: [String]
show_read_tests = unit_tester t_show_read test_patches ++
                  unit_tester t_show_read test_patches_named
primitive_show_read_tests :: [String]
primitive_show_read_tests = unit_tester t_show_read primitive_test_patches
t_show_read :: (Eq p, Show p, Patchy p) => PatchUnitTest p
t_show_read 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}
canonization_tests :: [String]
canonization_tests = concatMap check_known_canon known_canons
check_known_canon :: (Patch, Patch) -> [String]
check_known_canon (p1,p2) =
    if (fromPrims $ concatFL $ mapFL_FL canonize $ sort_coalesceFL $ effect p1) == p2
    then []
    else ["Canonization failed:\n"++show p1++"canonized is\n"
          ++show (fromPrims $ concatFL $ mapFL_FL canonize $ sort_coalesceFL $ effect p1 :: Patch)
          ++"which is not\n"++show p2]
known_canons :: [(Patch,Patch)]
known_canons =
    [(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}
generic_merge_tests :: [String]
generic_merge_tests =
  case take 400 [(p1:\/:p2)|
                 i <- [0..(length test_patches)-1],
                 p1<-[test_patches!!i],
                 p2<-drop i test_patches,
                 check_a_patch $ join_patches [invert p2,p1]] of
  merge_pairs -> (parallel_pair_unit_tester t_merge_either_way_valid merge_pairs) ++
                 (parallel_pair_unit_tester t_merge_swap_merge merge_pairs)
t_merge_either_way_valid   :: TwoPatchUnitTest
t_merge_either_way_valid p1 p2 =
  case join_patches [p2, quickmerge (p1:\/: p2)] of
  combo2 ->
    case join_patches [p1, quickmerge (p2:\/: p1)] of
    combo1 ->
      if not $ check_a_patch $ join_patches [combo1]
      then ["oh my combo1 invalid:\n"++show p1++"and...\n"++show p2++show combo1]
      else
        if check_a_patch $ join_patches [invert combo1, combo2]
        then []
        else ["merge both ways invalid:\n"++show p1++"and...\n"++show p2++
              show combo1++
              show combo2]
t_merge_swap_merge   :: TwoPatchUnitTest
t_merge_swap_merge 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
commutex with one another.

\begin{code}
commute_recommute_tests :: [String]
commute_recommute_tests =
  case take 200 [(p2:<p1)|
                 p1<-test_patches,
                 p2<-filter (\p->checkseq [p1,p]) test_patches,
                 commutex (p2:<p1) /= Nothing] of
  commute_pairs -> pair_unit_tester t_commute_recommute commute_pairs
  where checkseq ps = check_a_patch $ join_patches ps
primitive_commute_recommute_tests :: [String]
primitive_commute_recommute_tests =
  pair_unit_tester t_commute_recommute
    [(p1:<p2)|
     p1<-primitive_test_patches,
     p2<-primitive_test_patches,
     commutex (p1:<p2) /= Nothing,
     check_a_patch $ join_patches [p2,p1]]
t_commute_recommute   :: TwoPatchUnitTest
t_commute_recommute p1 p2 =
    if (commutex (p1:<p2) >>= commutex) == Just (p1:<p2)
       then []
       else ["Failed to recommute:\n"++(show p1)++(show p2)++
            "we saw it as:\n"++show (commutex (p1:<p2))++
             "\nAnd recommute was:\n"++show (commutex (p1:<p2) >>= commutex)
             ++ "\n"]
\end{code}

\chapter{Commute tests}

Here we provide a set of known interesting commutes.
\begin{code}
commute_tests :: [String]
commute_tests =
    concatMap check_known_commute known_commutes++
    concatMap check_cant_commute known_cant_commute
check_known_commute :: (Patch:< Patch, Patch:< Patch) -> [String]
check_known_commute (p1:<p2,p2':<p1') =
   case commutex (p1:<p2) of
   Just (p2a:<p1a) ->
       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 commutex (p2':<p1') of
   Just (p1a:<p2a) ->
       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']
known_commutes :: [(Patch:<Patch,Patch:<Patch)]
known_commutes = [
                  (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)

check_cant_commute :: (Patch:< Patch) -> [String]
check_cant_commute (p1:<p2) =
    case commutex (p1:<p2) of
    Nothing -> []
    _ -> [show p1 ++ "\n\n" ++ show p2 ++
          "\nArgh, these guys shouldn't commutex!\n"]
known_cant_commute :: [(Patch:< Patch)]
known_cant_commute = [
                      (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}
merge_tests :: [String]
merge_tests =
    concatMap check_known_merge_equiv known_merge_equivs++
    concatMap check_known_merge known_merges
check_known_merge :: (Patch:\/: Patch, Patch:< Patch) -> [String]
check_known_merge (p1:\/:p2,p1':<p2') =
   case merge (p1:\/:p2) of
   _ :/\: p1a ->
       if (p1a:< p2) == (p1':< p2')
       then []
       else ["Merge gave wrong value!\n"++show p1++show p2
             ++"I expected\n"++show p1'++show p2'
             ++"but found instead\n"++show p1a]
known_merges :: [(Patch:\/:Patch,Patch:<Patch)]
known_merges = [
                (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 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 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"]),
                (testhunk 3 [BC.pack "A"] []:\/:
                 testhunk 1 [BC.pack "B"] [],
                 testhunk 2 [BC.pack "A"] []:<
                 testhunk 1 [BC.pack "B"] []),
                (fromPrim (rmdir "./test/world"):\/:
                 fromPrim (hunk "./world" 3 [BC.pack "A"] []),
                 fromPrim (rmdir "./test/world"):<
                 fromPrim (hunk "./world" 3 [BC.pack "A"] [])),

                (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"]:<
                 join_patches [quickhunk 3 "a" "bc",
                               quickhunk 8 "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 "B"] [BC.pack "C"]),

                (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"]:<
                 testhunk 1 [BC.pack "B"] [BC.pack "C",BC.pack "D"])]
  where testhunk l o n = fromPrim $ hunk "test" l o n
check_known_merge_equiv :: (Patch:\/:Patch,Patch) -> [String]
check_known_merge_equiv (p1:\/: p2, pe) =
    case quickmerge (p1:\/:p2) of
    p1' -> if check_a_patch $ 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]
known_merge_equivs :: [(Patch:\/: Patch, Patch)]
known_merge_equivs = [

                     -- 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}
merge_swap_tests :: [String]
merge_swap_tests =
    concat
              [check_merge_swap p1 p2 |
               p1<-primitive_test_patches,
               p2<-primitive_test_patches,
               check_a_patch $ join_patches [invert p1,p2]
              ]
check_merge_swap :: Patch -> Patch -> [String]
check_merge_swap p1 p2 =
    case merge (p2:\/:p1) of
    _ :/\: p2' ->
        case merge (p1:\/:p2) of
        _ :/\: p1' ->
            case commutex (p2':<p1) 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 commutex 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}
test_patches :: [Patch]
test_patches_named :: [Named Patch]
test_patches_addfile :: [Patch]
test_patches_rmfile :: [Patch]
test_patches_hunk :: [Patch]
primitive_test_patches :: [Patch]
test_patches_binary :: [Patch]
test_patches_composite_nocom :: [Patch]
test_patches_composite :: [Patch]
test_patches_two_composite_hunks :: [Patch]
test_patches_composite_hunks :: [Patch]
test_patches_composite_four_hunks :: [Patch]
test_patches_merged :: [Patch]
valid_patches :: [Patch]

test_patches_named = [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")]
test_patches_addfile = map fromPrim
                       [addfile "test",adddir "test",addfile "test/test"]
test_patches_rmfile = map invert test_patches_addfile
test_patches_hunk  =
    [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"]]

primitive_test_patches = test_patches_addfile ++
                         test_patches_rmfile ++
                         test_patches_hunk ++
                         [unsafeUnseal.fst.fromJust.readPatch $
                          BC.pack "move ./test/test ./hello",
                          unsafeUnseal.fst.fromJust.readPatch $
                          BC.pack "move ./test ./hello"] ++
                         test_patches_binary

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

test_patches_composite_nocom =
    take 50 [join_patches [p1,p2]|
             p1<-primitive_test_patches,
             p2<-filter (\p->checkseq [p1,p]) primitive_test_patches,
             commutex (p2:<p1) == Nothing]
    where checkseq ps = check_a_patch $ join_patches ps

test_patches_composite =
    take 100 [join_patches [p1,p2]|
              p1<-primitive_test_patches,
              p2<-filter (\p->checkseq [p1,p]) primitive_test_patches,
              commutex (p2:<p1) /= Nothing,
              commutex (p2:<p1) /= Just (p1:<p2)]
    where checkseq ps = check_a_patch $ join_patches ps

test_patches_two_composite_hunks =
    take 100 [join_patches [p1,p2]|
              p1<-test_patches_hunk,
              p2<-filter (\p->checkseq [p1,p]) test_patches_hunk]
    where checkseq ps = check_a_patch $ join_patches ps

test_patches_composite_hunks =
    take 100 [join_patches [p1,p2,p3]|
              p1<-test_patches_hunk,
              p2<-filter (\p->checkseq [p1,p]) test_patches_hunk,
              p3<-filter (\p->checkseq [p1,p2,p]) test_patches_hunk]
    where checkseq ps = check_a_patch $ join_patches ps

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

test_patches_merged =
  take 200
    [joinPatches $ flattenFL p2+>+flattenFL (quickmerge (p1:\/:p2)) |
     p1<-take 10 (drop 15 test_patches_composite_hunks)++primitive_test_patches
         ++take 10 (drop 15 test_patches_two_composite_hunks)
         ++ take 2 (drop 4 test_patches_composite_four_hunks),
     p2<-take 10 test_patches_composite_hunks++primitive_test_patches
         ++take 10 test_patches_two_composite_hunks
         ++take 2 test_patches_composite_four_hunks,
     check_a_patch $ join_patches [invert p1, p2],
     commutex (p1:<p2) /= Just (p2:<p1)
    ]

test_patches =  primitive_test_patches ++
                test_patches_composite ++
                test_patches_composite_nocom ++
                test_patches_merged
\end{code}

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

\begin{code}
valid_patches = [(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"])]++test_patches

test_check :: [String]
test_check = unit_tester t_test_check valid_patches
t_test_check :: PatchUnitTest Patch
t_test_check p = if check_a_patch p
                 then []
                 else ["Failed the check:  "++show p++"\n"]

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

check_subcommutes :: Testable a => [(String, a)] -> String -> IO ()
check_subcommutes [] _ = return ()
check_subcommutes ((n,c):r) expl =
    do putStr $ "Checking " ++ expl ++ " for subcommute " ++ n ++ "... "
       quickCheck c
       check_subcommutes r expl
\end{code}

\end{document}