# Tests for the 'DiffUtil' package. -*- tcl -*-
#
# Copyright (c) 2010 by Peter Spjuth. All rights reserved.

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] != ""}]

# All tests are for C only
if {[info proc DiffUtil::ExecDiffFiles] != ""} return
#----------------------------------------------------------------------

# A wrapper to simplify calling
proc RunTest {data1 data2 args} {
    set ch [open _diff_1 wb]
    puts -nonewline $ch $data1
    close $ch
    set ch [open _diff_2 wb]
    puts -nonewline $ch $data2
    close $ch

    set ch1 [open _diff_1 rb]
    set ch2 [open _diff_2 rb]

    set apa [catch {DiffUtil::compareStreams {*}$args $ch1 $ch2} res]
    close $ch1
    close $ch2
    file delete -force _diff_1 _diff_2
    if {$apa} {
        return [list $apa $res]
    }
    return $res
}

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

test comparestreams-1.1 {standard cases} {
    set l1 {abcd}
    set l2 {abcd}
    RunTest $l1 $l2
} 1

test comparestreams-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 comparestreams-1.3 {standard cases, error} -body {
    DiffUtil::compareStreams a
} -returnCodes 1 -result "wrong # args*" -match glob

test comparestreams-1.4 {standard cases} {
    set l1 {abcd}
    set l2 {abcde}
    RunTest $l1 $l2
} 0

test comparestreams-1.5 {standard cases} {
    set l1 {abcd}
    set l2 {abce}
    RunTest $l1 $l2
} 0

test comparestreams-1.6 {standard cases} {
    set l1 {abcd}
    set l2 {abcD}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -nocase]
} {0 1}

test comparestreams-2.1 {keywords} {
    set l1 {abcd}
    set l2 {abcD}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 0}

test comparestreams-2.2 {keywords} {
    set l1 {abcd $apa$}
    set l2 {abcd $apa: hej$}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 1}

test comparestreams-2.3 {keywords} {
    set l1 {abcd $apa::$}
    set l2 {abcd $apa: hej$}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 1}

test comparestreams-2.4 {keywords vs namespace vars} {
    set l1 {abcd $apa::hej$apa::hopp}
    set l2 {abcd $apa::haj$apa::hipp}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 0}

test comparestreams-2.5 {keywords} {
    set l1 {abcd $apa: hejsan$ hopp}
    set l2 {abcd $apa: hoppsan$ hopp}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 1}

test comparestreams-2.6 {keywords} {
    # Longer version of 2.5. Handle larger than block size.
    set l1 {abcd $apa: hejsan$ hopp}
    set l2 {abcd $apa: hoppsan$ hopp}
    append l1 [string repeat gurka 20000]
    append l2 [string repeat gurka 20000]
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 1}

test comparestreams-2.7 {keywords} {
    set l1 {abcd $apa: hejsan$ hopp $bepa: hugo$ nej}
    set l2 {abcd $apa: hoppsan$ hopp $bepa: apa$ nej}
    list [RunTest $l1 $l2] [RunTest $l1 $l2 -ignorekey]
} {0 1}

test comparestreams-2.8 {keywords} {
    set base1 {abcd $apa: hejsan$ hopp}
    set base2 {abcd $apa: hoppsan$ hopp}
    set lastOk 0
    # This will eventually fail when the keyword reaches the block size.
    for {set l 65500} {$l < 65540} {incr l} {
        set s1 [string repeat x $l]$base1
        set s2 [string repeat x $l]$base2
        if {[RunTest $s1 $s2 -ignorekey]} {
            set lastOk $l
        }
    }
    # Check that it worked long enough, but not too long
    expr {$lastOk > 65510 && $lastOk != 65539 ? 1 : $lastOk}
} {1}
