%  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 System.IO.Unsafe ( unsafePerformIO )
import ByteStringUtils hiding ( intercalate )
import Codec.Binary.UTF8.Generic ( toString )
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 ( patch_unit_tests )
import Darcs.Test.Email ( email_parsing, email_header_no_long_lines,
                          email_header_ascii_chars, email_header_lines_start,
                          email_header_no_empty_lines )
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 primitive_test_patches))
            ++" primitive patches.\n")
    putStr ("There are a total of "++
            (show (length test_patches))++" 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 = patch_unit_tests ++
        [testBool "Checking that UTF-8 packing and unpacking preserves 'hello world'"
                  (toString (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"),
         email_parsing,
         email_header_no_long_lines,
         email_header_ascii_chars,
         email_header_lines_start,
         email_header_no_empty_lines,
         testProperty "Checking that B.concat works" prop_concatPS,
         testProperty "Checking that hex conversion works" prop_hex_conversion,
         testProperty "Checking that show and read work right" prop_read_show,
         testStringList "Checking known commutes" commute_tests,
         testStringList "Checking known merges" merge_tests,
         testStringList "Checking known canons" canonization_tests]
        ++ check_subcommutes subcommutes_inverse "patch and inverse both commute"
        ++ check_subcommutes subcommutes_nontrivial_inverse "nontrivial commutes are correct"
        ++ check_subcommutes subcommutes_failure "inverses fail"
        ++
        [testProperty "Checking that commuting by patch and its inverse is ok" prop_commute_inverse,
         --putStr "Checking that conflict resolution is valid... "
         --runQuickCheckTest returnval prop_resolve_conflicts_valid
         testProperty "Checking that a patch followed by its inverse is identity" prop_patch_and_inverse_is_identity,
         -- The following tests are "wrong" with the Conflictor code.
         --putStr "Checking that a simple smart_merge is sufficient... "
         --runQuickCheckTest returnval prop_simple_smart_merge_good_enough
         --putStr "Checking that an elegant merge is sufficient... "
         --runQuickCheckTest returnval prop_elegant_merge_good_enough
         testProperty "Checking that commutes are equivalent" prop_commute_equivalency,
         testProperty "Checking that merges are valid" prop_merge_valid,
         testProperty "Checking inverses being valid" prop_inverse_valid,
         testProperty "Checking other inverse being valid" prop_other_inverse_valid,
         testStringList "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... "
         --runQuickCheckTest returnval prop_unravel_order_independent
         --putStr "Checking the unravelling of three merges... "
         --runQuickCheckTest returnval prop_unravel_three_merge
         --putStr "Checking the unravelling of a merge of a sequence... "
         --runQuickCheckTest returnval prop_unravel_seq_merge
         testProperty "Checking inverse of inverse" prop_inverse_composition,
         testProperty "Checking the order of commutes" prop_commute_either_order,
         testProperty "Checking commute either way" prop_commute_either_way,
         testProperty "Checking the double commute" prop_commute_twice,
         testProperty "Checking that merges commute and are well behaved" prop_merge_is_commutable_and_correct,
         testProperty "Checking that merges can be swapped" prop_merge_is_swapable,
         testProperty "Checking again that merges can be swapped (I'm paranoid) " prop_merge_is_swapable,
         testStringList "Checking that the patch validation works" test_check,
         testStringList "Checking commute/recommute" commute_recommute_tests,
         testStringList "Checking merge properties" generic_merge_tests,
         testStringList "Testing the lcs code" show_lcs_tests,
         testStringList "Checking primitive patch IO functions" primitive_show_read_tests,
         testStringList "Checking IO functions" show_read_tests,
         testStringList "Checking primitive commute/recommute" primitive_commute_recommute_tests
        ]
\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]

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 = concatMap t_show_read test_patches ++
                  concatMap t_show_read test_patches_named
primitive_show_read_tests :: [String]
primitive_show_read_tests = concatMap 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 $ 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]
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
commute 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,
                 commute (p1:>p2) /= 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,
     commute (p2:>p1) /= Nothing,
     check_a_patch $ join_patches [p2,p1]]
t_commute_recommute   :: TwoPatchUnitTest
t_commute_recommute 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}
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 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']
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 commute (p2:>p1) of
    Nothing -> []
    _ -> [show p1 ++ "\n\n" ++ show p2 ++
          "\nArgh, these guys shouldn't commute!\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 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}
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,
             commute (p1:>p2) == 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,
              commute (p1:>p2) /= Nothing,
              commute (p1:>p2) /= Just (p2:>p1)]
    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],
     commute (p2:>p1) /= Just (p1:>p2)
    ]

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 = concatMap 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)

-- | Groups a set of tests by giving them the same prefix in their description.
--   When this is called as @check_subcommutes subcoms expl@, the prefix for a
--   test becomes @"Checking " ++ expl ++ " for subcommute "@.
check_subcommutes :: Testable a => [(String, a)] -> String
                                                 -> [Test]
check_subcommutes 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}