# Tests for the 'DiffUtil' package. -*- tcl -*-
#
# Copyright (c) 2004 by Peter Spjuth. All rights reserved.
#
# $Revision: 1.8 $

package require DiffUtil

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

# There are differences between the C and the Diff result.
tcltest::testConstraint CDiff \
        [expr {[info proc DiffUtil::ExecDiffFiles] == ""}]
tcltest::testConstraint TclDiff \
        [expr {[info proc DiffUtil::ExecDiffFiles] != ""}]
# Some tests are not expected to work with the LCS fallback
tcltest::testConstraint LcsDiff   [expr [info exists ::env(DIFFUTIL_DIFFNAME)]]
tcltest::testConstraint NoLcsDiff [expr ![info exists ::env(DIFFUTIL_DIFFNAME)]]

#----------------------------------------------------------------------

# A wrapper to simplify calling
proc RunTest {list1 list2 args} {
    set ch [open _diff_1 wb]
    if {[llength $list1] > 0} {
        puts $ch [join $list1 \n]
    }
    close $ch
    set ch [open _diff_2 wb]
    if {[llength $list2] > 0} {
        puts $ch [join $list2 \n]
    }
    close $ch

    set apa [catch {eval DiffUtil::diffFiles $args _diff_1 _diff_2} res]
    file delete -force _diff_1 _diff_2
    if {$apa} {
        return [list $apa $res]
    }
    return $res
}

#----------------------------------------------------------------------

test difffiles-1.1 {standard cases} {
    set l1 {a b c d   f g h i j k l}
    set l2 {  b c d e f g x y   k l}
    RunTest $l1 $l2
} [list {1 1 1 0} {5 0 4 1} {7 3 7 2}]

test difffiles-1.2 {standard cases, error} -body {
    set l1 {a b c d   f g h i j k l}
    set l2 {  b c d e f g x y   k l}
    RunTest $l1 $l2 -hubba
} -result [list 1 {bad option "-hubba"*}] -match glob

test difffiles-1.3 {standard cases, error} -body {
    DiffUtil::diffFiles a
} -returnCodes 1 -result "wrong # args*" -match glob

test difffiles-2.1 {alignment, no align} {
    set l1 {a b c d  }
    set l2 {a   c d b}
    RunTest $l1 $l2
} [list {2 1 2 0} {5 0 4 1}]

test difffiles-2.2 {alignment} {
    set l1 {a     b c d}
    set l2 {a c d b    }
    RunTest $l1 $l2 -align {2 4}
} [list {2 0 2 2} {3 2 5 0}]

test difffiles-2.3 {alignment, error} -body {
    DiffUtil::diffFiles -align {1} a b
} -returnCodes 1 -result {bad align*} -match glob

test difffiles-2.4 {alignment, impossible align ignored} {
    set l1 {a     b c d}
    set l2 {a c d b    }
    RunTest $l1 $l2 -align {2 4 3 2}
} [list {2 0 2 2} {3 2 5 0}]

test difffiles-2.5 {alignment+range} -body {
    set l1 {a     b c d e}
    set l2 {x c d b     y}
    RunTest $l1 $l2 -align {2 4} -range {2 4 2 4}
} -result [list {2 0 2 2} {3 2 5 0}]

test difffiles-2.6 {alignment, switched order} {
    set l1 {a     b c d e f g    }
    set l2 {a c d b         g e f}
    RunTest $l1 $l2 -align {7 5 2 4}
} [list {2 0 2 2} {3 4 5 0} {8 0 6 2}]

test difffiles-2.7.1 {alignment, no align} {
    set l1 {a b c  d }
    set l2 {e f g  d }
    RunTest $l1 $l2
} [list {1 3 1 3}]

test difffiles-2.7.2 {alignment} {
    set l1 {    a b c d }
    set l2 {e f g     d }
    RunTest $l1 $l2 -align {1 3}
} [list {1 0 1 2} {1 1 3 1} {2 2 4 0}]

test difffiles-2.7.3 {alignment} {
    set l1 {a   b c d }
    set l2 {e f g   d }
    RunTest $l1 $l2 -align {1 1 2 3}
} [list {1 1 1 1} {2 0 2 1} {2 1 3 1} {3 1 4 0}]

test difffiles-2.7.4 {alignment} {
    set l1 {a b   c  d }
    set l2 {  e f g  d }
    RunTest $l1 $l2 -align {2 1 3 3}
} [list {1 1 1 0} {2 1 1 1} {3 0 2 1} {3 1 3 1}]

test difffiles-3.1 {ignore space} {
    set l1 {a {b c} d e f {g h}  i}
    set l2 {a {bc}  x e f {g  h} i}
    RunTest $l1 $l2
} [list {2 2 2 2} {6 1 6 1}]

test difffiles-3.2 {ignore space} {
    set l1 {a {b c} d e f {g h}  i}
    set l2 {a {bc}  x e f {g  h} i}
    RunTest $l1 $l2 -b
} [list {2 2 2 2}]

test difffiles-3.3 {ignore space} {
    set l1 {a {b c} d e f {g h}  i}
    set l2 {a {bc}  x e f {g  h} i}
    RunTest $l1 $l2 -w
} [list {3 1 3 1}]


test difffiles-4.1 {range} {
    set l1 {a bc d e f gh  i}
    set l2 {a xy x e f ghh i}
    RunTest $l1 $l2 -range {3 5 3 6}
} [list {3 1 3 1} {6 0 6 1}]

test difffiles-4.2 {range} -body {
    DiffUtil::diffFiles -range {3 5 3} a b
} -returnCodes 1 -result {bad range*} -match glob

test difffiles-4.3 {range} -body {
    DiffUtil::diffFiles -range {-3 5 3 5} a b
} -returnCodes 1 -result {bad range*} -match glob

test difffiles-4.4 {range} {
    # Use many empty lines to stress the part in implementation where lines
    # before range are ignored.
    set l1 [lrepeat 100 a {} b]
    set l2 [lrepeat 100 a {} c]
    RunTest $l1 $l2 -range {22 27 34 39}
} [list {24 1 36 1} {27 1 39 1}]

test difffiles-4.5 {range} {
    # Use many empty lines to stress the part in implementation where lines
    # before range are ignored.
    set l1 [lrepeat 100 a {} {} b]
    set l2 [lrepeat 100 a b {} {}]
    RunTest $l1 $l2 -range {41 48 61 68} -pivot 5
} [list {42 0 62 1} {44 1 65 0} {46 0 66 1} {48 1 69 0}]

test difffiles-5.1a {priority} {NoLcsDiff} {
    # The changed block is kept together
    set l1 {a b c d       e}
    set l2 {a b c d f e E e}
    RunTest $l1 $l2
} [list {5 0 5 3}]

test difffiles-5.1b {priority} {LcsDiff} {
    # The changed block is kept together
    # This is the result of tcllib's LCS
    set l1 {a b c d   e    }
    set l2 {a b c d f e E e}
    RunTest $l1 $l2
} [list {5 0 5 1} {6 0 7 2}]

test difffiles-5.2 {priority} {
    # No prio here, just a reference for the following nocase
    set l1 {a b c d   e}
    set l2 {a b c d f e E}
    RunTest $l1 $l2
} [list {5 0 5 1} {6 0 7 1}]

test difffiles-5.3 {priority} {CDiff} {
    # Same case as before but with prio
    # The correct case has priority even if it means two changes
    set l1 {a b c d   e}
    set l2 {a b c d f e E}
    RunTest $l1 $l2 -nocase
} [list {5 0 5 1} {6 0 7 1}]

test difffiles-5.4a {priority} {NoLcsDiff} {
    # Same case again but no correct case, single block preferred
    set l1 {a b c d     e}
    set l2 {a b c d f E E}
    RunTest $l1 $l2 -nocase
} [list {5 0 5 2}]

test difffiles-5.4b {priority} {LcsDiff} {
    # Same case again but no correct case, single block preferred
    # This is the result of tcllib's LCS
    set l1 {a b c d   e  }
    set l2 {a b c d f E E}
    RunTest $l1 $l2 -nocase
} [list {5 0 5 1} {6 0 7 1}]

test difffiles-5.5 {priority} {
    # Here efgh can match in two places, the first is chosen
    set l1 {a b c d   e f g h             i j k l}
    set l2 {a b c d X e f g h Y e f g h Z i j k l}
    RunTest $l1 $l2
} [list {5 0 5 1} {9 0 10 6}]

test difffiles-5.6a {priority} {NoLcsDiff} {
    # Here efgh can match in two places, the second is chosen since it
    # keeps things together
    set l1 {a b c d             e f g h i j k l}
    set l2 {a b c d X e f g h Y e f g h i j k l}
    RunTest $l1 $l2
} [list {5 0 5 6}]

test difffiles-5.6b {priority} {LcsDiff} {
    # This is the result of tcllib's LCS
    set l1 {a b c d   e f g h           i j k l}
    set l2 {a b c d X e f g h Y e f g h i j k l}
    RunTest $l1 $l2
} [list {5 0 5 1} {9 0 10 5}]

test difffiles-5.7 {priority} {CDiff} {
    # Multiple blocks starting alike where one block is removed
    set l1 {a b c d e {} a b f g h {} a b i j k}
    set l2 {a b c d e {}              a b i j k}
    # 6    {a b c d e              {} a b i j k}
    # 7    {a b c d e {}              a b i j k}
    # 8    {a b c d e {} a              b i j k}
    # 9    {a b c d e {} a b              i j k}
    list [RunTest $l1 $l2] [RunTest $l2 $l1]
    # Any start line from 6-9 are correct bet from a visual point of
    # view 6 or 7 are preferable.
} [list [list {7 6 7 0}] [list {7 0 7 6}]]

test difffiles-5.7.2 {priority} {TclDiff} { # Same as 5.7, tcl version
    # This corresponds to line 9 above
    set l1 {a b c d e {} a b f g h {} a b i j k}
    set l2 {a b c d e {} a b              i j k}
    RunTest $l1 $l2
} [list {9 6 9 0}]

test difffiles-5.8 {priority} {
    # Multiple blocks ending alike where one block is removed
    set l1 {a b c d e {} f g h d e {} i j k d e}
    set l2 {a b c d e {}              i j k d e}
    RunTest $l1 $l2
    # Any start line from 6-9 are correct bet from a visual point of
    # view 6 or 7 are preferable.
} [list {7 6 7 0}]

test difffiles-6.1 {noempty} -body {
    set l1 {a b c {} d {}   e f g}
    set l2 {a b c {}   {} d e f g}
    RunTest $l1 $l2
} -result [list {5 1 5 0} {7 0 6 1}]

test difffiles-6.2 {noempty} -constraints {CDiff} -body {
    set l1 {a b c {}    d {} e f g}
    set l2 {a b c {} {} d    e f g}
    RunTest $l1 $l2 -noempty
} -result [list {5 0 5 1} {6 1 7 0}]

test difffiles-6.3 {noempty} -constraints {CDiff} -body {
    # Stretches of empty should still be handled
    set l1 {a b c {} {}    d {} e f g}
    set l2 {a b c {} {} {} d    e f g}
    RunTest $l1 $l2 -noempty
} -result [list {6 0 6 1} {7 1 8 0}]

test difffiles-6.4 {noempty} -constraints {CDiff} -body {
    # Stretches of empty should still be handled
    set l1 {a b c {} {} {} d {} {} e f g}
    set l2 {a b c {} {} {} d {} {} e h g}
    RunTest $l1 $l2 -noempty
} -result [list {11 1 11 1}]

test difffiles-6.5 {noempty} -constraints {CDiff} -body {
    # Long strech of empty, to trigger reallocation
    set l1 {a b c {} {} {} d {} {} e f g {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} x}
    set l2 {a b c {} {} {} d {} {} e h g {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} x}
    RunTest $l1 $l2 -noempty
} -result [list {11 1 11 1}]

test difffiles-6.6 {noempty} -constraints {CDiff} -body {
    # Handle empty within a change group
    set l1 {a b c d e {} f g}
    set l2 {a b c d q {} x g}
    RunTest $l1 $l2 -noempty
} -result [list {5 1 5 1} {7 1 7 1}]

test difffiles-7.1 {ignore digit} -body {
    set l1 {a b123c x b02c   b13c d}
    set l2 {a         b02c x      d}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -nodigit]
} -result [list [list {2 2 2 0} {5 1 3 1}] [list {4 2 4 0}]]

test difffiles-7.2 {ignore digit} -body {
    set l1 {a b123 12c 456   a76b93u x}
    set l2 {a b2   1c  7890  a0b12u  x}
    RunTest $l1 $l2 -nodigit
} -result {}

test difffiles-7.3a {ignore digit, preference} {CDiff} {
    set l1 {a b123 b456 x}
    set l2 {a b123      x}
    set l3 {a b222      x}
    set l4 {a b456      x}
    list [RunTest $l1 $l2 -nodigit] \
            [RunTest $l1 $l3 -nodigit] \
            [RunTest $l1 $l4 -nodigit]
} [list [list {3 1 3 0}] [list {3 1 3 0}] [list {2 1 2 0}]]

test difffiles-7.3b {ignore digit, preference} {TclDiff} {
    # Tcl version fully ignores, and cannot prefer the exact match
    set l1 {a b123 b456 x}
    set l2 {a b123      x}
    set l3 {a b222      x}
    set l4 {a b456      x}
    list [RunTest $l1 $l2 -nodigit] \
            [RunTest $l1 $l3 -nodigit] \
            [RunTest $l1 $l4 -nodigit]
} [list [list {3 1 3 0}] [list {3 1 3 0}] [list {3 1 3 0}]]

test difffiles-8.1 {flag -regsub} {
    set l1 {axa byb aa bb}
    set l2 {aya bxb ee ff}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -regsub {{x|y} {}}]
} [list [list {1 4 1 4}] [list {3 2 3 2}]]

test difffiles-8.2 {flag -regsub} {
    set l1 {axa byb axa bb}
    set l2 {    aya bxb ee ff}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -regsub {{.*(y|x).*} {\1}}]
} [list [list {1 4 1 4}] [list {1 1 1 0} {4 1 3 2}]]

test difffiles-8.3 {flag -regsub} {
    set l1 {axa byb epe bb}
    set l2 {apa bqb exe ff}
    list [RunTest $l1 $l2] \
            [RunTest $l1 $l2 -regsubleft {{x|y} {}} -regsubright {{p|q} {}}] \
            [RunTest $l1 $l2 -regsub {{x|y} {}} -regsub {{p|q} {}}]
} [list [list {1 4 1 4}] [list {3 2 3 2}] [list {4 1 4 1}]]

test difffiles-9.1 {hash} {
    # Different elements that hash to the same thing.
    # Hash is currenctly hash = hash*129+char, and run over utf-8 string.
    # \x83 becomes \xc2 \x83 in utf-8.
    set l1 {a ab\x83 c}
    set l2 {a ac\x42\x02 c}
    RunTest $l1 $l2
} [list {2 1 2 1}]

test difffiles-10.1 {result style} -constraints {CDiff} -body {
    DiffUtil::diffFiles -result {} {}
} -returnCodes 1 -result "wrong # args*" -match glob

test difffiles-10.2 {result style} -constraints {CDiff} -body {
    DiffUtil::diffFiles -result gurka {} {}
} -returnCodes 1 -result {bad result style "gurka": must be diff or match}

test difffiles-10.3 {result style} {CDiff} {
    set l1 {a b c}
    set l2 {a d c}
    RunTest $l1 $l2 -result diff
} [list {2 1 2 1}]

test difffiles-10.4 {result style} {CDiff} {
    set l1 {a b c}
    set l2 {a d c}
    RunTest $l1 $l2 -result match
} [list {1 3} {1 3}]

test difffiles-10.5 {result style} {CDiff} {
    set l1 {a b c d   f g h i j k l}
    set l2 {  b c d e f g x y   k l}
    RunTest $l1 $l2 -result match
} [list {2 3 4 5 6 10 11} {1 2 3 5 6 9 10}]

test difffiles-11.1 {channel config} {CDiff} {
    set l1 {a b c}
    set l2 {a d c}
    RunTest $l1 $l2 -encoding iso8859-1 -translation lf
} [list {2 1 2 1}]

test difffiles-11.2 {channel config} -constraints {CDiff} -body {
    set l1 {a b c}
    set l2 {a d c}
    RunTest $l1 $l2 -encoding gurkmeja
} -result {1 {unknown encoding "gurkmeja"}}

test difffiles-11.3 {channel config} -constraints {CDiff} -body {
    set l1 {a b c}
    set l2 {a d c}
    RunTest $l1 $l2 -translation gurkmeja
} -result {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}

test difffiles-11.4 {channel config} {CDiff} {
    set l1 {a \xc2\x82 c}
    set l2 {a \x82 c}
    list [RunTest $l1 $l2 -translation binary] [RunTest $l1 $l2 -encoding utf-8]
} [list [list {2 1 2 1}] {}]

test difffiles-12.1 {stack space bug} -body {
    # These files consume lots of candidate stack and crashed an earlier
    # version of diffUtil.
    DiffUtil::diffFiles -b [file join [configure -testdir] candbug1.txt] [file join [configure -testdir] candbug2.txt]
    return 0
} -result {0}

test difffiles-13.1 {long runtime bug} -constraints {CDiff} -body {
    # This case took very long time in an earlier version
    set l1 {}
    set l2 {}
    for {set t 0} {$t < 1000} {incr t} {
        lappend l1 a b c d e f g h i j k l m n o p q r s t 
        lappend l2 a b c d e f g h i j k l m n o p q r s t 
    }
    #puts "Biggie test"
    set result [RunTest $l1 $l2 -pivot 900]
    #puts "Biggie test done"
    set result
} -result {}

test difffiles-13.2 {long runtime bug} -constraints {} -body {
    # Same as 13.1 but smaller, just to run a similar thing in all
    # implementations
    set l1 {}
    set l2 {}
    for {set t 0} {$t < 100} {incr t} {
        lappend l1 a b c d e f g h i j k l m n o p q r s t 
        lappend l2 a b c d e f g h i j k l m n o p q r s t 
    }
    set result [RunTest $l1 $l2 -pivot 900]
} -result {}

test difffiles-14.1 {pivot bug} -constraints CDiff -body {
    # These files caused an error in post-processing of forbidden lines
    set x [DiffUtil::diffFiles -pivot 100 [file join [configure -testdir] pivot1.txt] [file join [configure -testdir] pivot2.txt]]
    llength $x
} -result {160}

test difffiles-15.1a {forbidden stressing} -constraints {NoLcsDiff} -body {
    # Try to stress the postprocessing of forbidden matches
    # This is the result of diff and C without pivot
    set l1 {}
    set l2 {}
    lappend l1   a0 b c a1 b    c a2 b    c a3 b    c a4 b    c
    lappend l2   a0   c    b a1 c    b a2 c    b a3 c    b a4 c b
    set result [RunTest $l1 $l2 -pivot 6]
} -result {{2 1 2 0} {4 1 3 0} {6 0 4 1} {7 1 6 0} {9 0 7 1} {10 1 9 0} {12 0 10 1} {13 1 12 0} {15 0 13 1} {16 0 15 1}}

test difffiles-15.1b {forbidden stressing} -constraints {LcsDiff} -body {
    # Try to stress the postprocessing of forbidden matches
    # This is the result of tcllib's LCS
    set l1 {}
    set l2 {}
    lappend l1   a0 b c   a1 b c   a2 b c   a3 b c   a4 b c
    lappend l2   a0   c b a1   c b a2   c b a3   c b a4   c b
    set result [RunTest $l1 $l2 -pivot 6]
} -result {{2 1 2 0} {4 0 3 1} {5 1 5 0} {7 0 6 1} {8 1 8 0} {10 0 9 1} {11 1 11 0} {13 0 12 1} {14 1 14 0} {16 0 15 1}}

test difffiles-15.1c {forbidden stressing} -constraints {CDiff} -body {
    # Try to stress the postprocessing of forbidden matches
    # This is the result of C with pivot low enough
    set l1 {}
    set l2 {}
    lappend l1   a0 b c   a1 b c   a2 b c   a3 b c   a4 b c
    lappend l2   a0   c b a1   c b a2   c b a3   c b a4   c b
    set result [RunTest $l1 $l2 -pivot 4]
    # Some here are fairly arbitrary and could just as well be different
    # with a tweaked implementation.
} -result {{2 1 2 0} {4 0 3 1} {5 1 5 0} {7 0 6 1} {8 1 8 0} {10 0 9 1} {11 1 11 0} {13 0 12 1} {14 1 14 0} {16 0 15 1}}

test difffiles-15.2 {forbidden and align} -constraints {CDiff} -body {
    # Forbidden matching must not break align-constraint
    set l1 {}
    set l2 {}
    lappend l1   a0     q b w a1 b b b a2 c c b a3 c c a4 c b
    lappend l2   a0 r b t     a1 b b b a2 c c b a3 c c a4 c b
    set result1 [RunTest $l1 $l2 -pivot 4]
    set result2 [RunTest $l1 $l2 -pivot 4 -align {2 4}]
    list $result1 $result2
} -result {{{2 1 2 1} {4 1 4 1}} {{2 0 2 2} {2 1 4 1} {3 2 5 0}}}

test difffiles-15.3 {forbidden} -constraints {CDiff} -body {
    # Try to stress the postprocessing of forbidden matches
    set l1 {}
    set l2 {}
    lappend l1  a0   b b c  a1 b c c   a2 b b c   
    lappend l2  a0 c b b    a1   c c b a2 c   c b
    lappend l1  a3 b c c   a4 b c   a5   b a6 b c
    lappend l2  a3   c b b a4   c b a5 c b a6   c
    set result [RunTest $l1 $l2 -pivot 4]
    # Some here are fairly arbitrary and could just as well be different
    # with a tweaked implementation.
} -result {{2 0 2 1} {4 1 5 0} {6 1 6 0} {9 0 8 1} {10 2 10 1} {13 0 12 1} {14 1 14 0} {16 1 15 2} {18 1 18 0} {20 0 19 1} {21 0 21 1} {23 1 24 0}}

test difffiles-16.1 {trivial cases} {} {
    set l1 {}
    set l2 {a b c}
    RunTest $l1 $l2
} [list {1 0 1 3}]

test difffiles-16.1b {trivial cases} {CDiff} {
    set l1 {}
    set l2 {a b c}
    RunTest $l1 $l2 -result match
} [list {} {}]

test difffiles-16.2 {trivial cases} {} {
    set l1 {a b}
    set l2 {}
    RunTest $l1 $l2
} [list {1 2 1 0}]

test difffiles-16.2b {trivial cases} {CDiff} {
    set l1 {a b}
    set l2 {}
    RunTest $l1 $l2 -result match
} [list {} {}]

test difffiles-16.3 {trivial cases} {} {
    set l1 {}
    set l2 {}
    RunTest $l1 $l2
} [list ]

test difffiles-16.3b {trivial cases} {CDiff} {
    set l1 {}
    set l2 {}
    RunTest $l1 $l2 -result match
} [list {} {}]

test difffiles-17.1 {gzip read} {CDiff} {
    set ch [open _diff_1 wb]
    zlib push gzip $ch
    puts $ch [join {a b c} \n]
    close $ch
    set ch [open _diff_2 wb]
    zlib push gzip $ch
    puts $ch [join {a d c} \n]
    close $ch
    set apa [catch {DiffUtil::diffFiles -gz _diff_1 _diff_2} res]
    file delete -force _diff_1 _diff_2
    if {$apa} {
        return [list $apa $res]
    }
    return $res
} [list {2 1 2 1}]
