#!/usr/bin/env tclsh

 proc usage {} {
        puts stderr "usage: tddiff dir1/ dir2/ out/"
        exit 1
 }

 proc assert {expr {msg {assertion failed}}} {
        if {![uplevel 1 expr $expr]} {error $msg}
 }

 proc main {argv} {
        if {[llength $argv] != 3} {
                usage
        }
        foreach {dir1 dir2 out} $argv {}
        assert {![file isdirectory $out]} "out directory '$out' already exists"
        assert {![file exists $out]} "out directory '$out' is a regular file"
        file mkdir $out
        foreach f [NewIn $dir1 $dir2 .] {Transfer $dir1 $out/new $f}
        foreach f [NewIn $dir2 $dir1 . on] {Transfer $dir2 $out/discarded $f}
 }

 # copy one file, creating directories if they miss
 proc Transfer {in out subpath} {
        set in $in/$subpath
        set dest $out/[file dirname $subpath]
        if {![file isdirectory $dest]} {
                puts "Creating directory $dest"
                file mkdir $dest
        }
        file copy $in $out/$subpath
 }

 proc NewIn {dir1 dir2 sub {deprecated off}} {
        set res ""
        foreach f [Subfiles $dir1 $sub] {
                if {[file isdirectory $dir1/$f]} {
                        set res [concat $res [NewIn $dir1 $dir2 $f $deprecated]]
                } else {
                        if {[NewFile $dir1/$f $dir2/$f $deprecated]} {lappend res $f}
                }
        }
        set res
 }

 # returns true if file2 does not exist or if file1 is different in content
 proc NewFile {file1 file2 {deprecated off}} {
        if {![file exists $file2]} {return true}
        if {$deprecated} {return false}
        return [expr {![BinEqual $file1 $file2]}]
 }

 proc min {a b} {expr {($a>$b)?($b):$a}}
 # compares two files, given their paths f1 and f2
 proc BinEqual {f1 f2} {
        if {[file size $f1] != [file size $f2]} {
                # not the same size -> not equal
                return false
        }
        set sz [file size $f1]
        set a [open $f1]
        set b [open $f2]
        fconfigure $a -translation binary
        fconfigure $b -translation binary
        while {![eof $a] && ![eof $b]} {
                if {![string equal [read $a [min $sz 4096]] [read $b [min $sz 4096]]]} {
                        close $a
                        close $b
                        return false
                }
                incr sz -4096
                if {$sz<0} {
                        close $a
                        close $b
                        return true
                }
        }
        close $a
        close $b
        return true
 }

 proc Subfiles {dir sub} {
        set p [pwd]
        cd $dir
        set res [glob -nocomplain $sub/*]
        cd $p
        set res
 }
 catch {tcldebug::debug}
 main $argv