# Tests for the tie module.                              -*- tcl -*- 
#
# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: tie_file.test,v 1.5 2005/09/28 04:51:24 andreas_kupries Exp $

if {![package vsatisfies [package provide Tcl] 8.4]} {
    puts "Aborting tests for snit."
    puts "Requiring Tcl 8.4, have [package present Tcl]"
    return
}

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

if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
    set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}

# -------------------------------------------------------------------------
# Ensure we test _this_ local copy and not one installed somewhere else.
# We also ensure to use local copies of the prerequisite packages.

package forget tie::std::file
package forget tie
package forget snit

catch {namespace delete tie::std::file}
catch {namespace delete tie}
catch {namespace delete snit}

if {[catch {source [file join [file dirname [info script]] .. snit snit.tcl]} msg]} {
    puts "skipped [file tail [info script]] (snit.tcl): $msg"
    return
}
if {[catch {source [file join [file dirname [info script]] tie_file.tcl]} msg]} {
    puts "skipped [file tail [info script]] (tie_file.tcl): $msg"
    return
}
if {[catch {source [file join [file dirname [info script]] tie.tcl]} msg]} {
    puts "skipped [file tail [info script]] (tie.tcl): $msg"
    return
}

puts "tie::std::file [package present tie::std::file]"
puts "- tie          [package present tie]"
puts "- snit         [package present snit]"

# -------------------------------------------------------------------------
# Takes a dictionary, returns a list containing the same dictionary,
# however the keys are sorted alphabetically. This allows for a true
# comparison of dictionary results.

proc dictsort {dict} {
    array set a $dict
    set out [list]
    foreach key [lsort [array names a]] {
	lappend out $key $a($key)
    }
    return $out
}

# -------------------------------------------------------------------------
# Creation of array daat sources
# Errors: Undefined variable, scalar, local variable

test tie-file-1.0 {file creation, wrong#args} {
    catch {tie::std::file} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}

test tie-file-1.1 {file creation, wrong#args} {
    catch {tie::std::file x} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}

test tie-file-1.2 {file creation, wrong#args} {
    catch {tie::std::file x y z} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}

test tie-file-1.3 {file creation, ok args, unwritable file} {unixOnly} {
    set f [makeFile {} journal]
    file attributes $f -permissions ugo-w
    catch {tie::std::file x $f} msg
    removeFile journal
    string map [list $f @] $msg
} {Error in constructor: couldn't open "@": permission denied}

test tie-file-1.4 {file creation, ok args, unwritable file} {winOnly} {
    set f [makeFile {} journal]
    file attributes $f -readonly 1
    catch {tie::std::file x $f} msg
    file attributes $f -readonly 0
    removeFile journal
    string map [list $f @] $msg
} {Error in constructor: couldn't open "@": permission denied}

test tie-file-1.5 {file creation, ok args, unreadable file} {unixOnly} {
    set f [makeFile {} journal]
    file attributes $f -permissions ugo-r
    catch {tie::std::file x $f} msg
    removeFile journal
     string map [list $f @] $msg
} {Error in constructor: couldn't open "@": permission denied}

test tie-file-1.6 {file creation, ok args, uncreateable file} {unixOnly} {
    set d [makeDirectory jtest]
    set f [makeFile {}   jtest/journal]
    removeFile jtest/journal
    file attributes $d -permissions ugo-w

    catch {tie::std::file x $f} msg

    removeFile      jtest/journal
    removeDirectory jtest
    string map [list $f @] $msg
} {Error in constructor: couldn't open "@": permission denied}

test tie-file-1.7 {file creation, ok args, uncreateable file} {knownBug winOnly} {
    set d [makeDirectory jtest]
    set f [makeFile {}   jtest/journal]
    removeFile jtest/journal
    file attributes $d -readonly 1

    catch {tie::std::file x $f} msg

    removeFile      jtest/journal
    removeDirectory jtest
    string map [list $f @] $msg
} {Error in constructor: couldn't open "@": permission denied}

test tie-file-1.8 {file creation, fixed name, array} {
    set f [makeFile {} journal]
    set msg [tie::std::file x $f]
    x destroy
    removeFile journal
    set msg
} {::x}

test tie-file-1.9 {file creation, %AUTO%} {
    set f [makeFile {} journal]
    set msg [tie::std::file %AUTO% $f]
    $msg destroy
    removeFile journal
    string match ::file\[79] $msg
} 1

# -------------------------------------------------------------------------
## Methods

test tie-file-2.0 {file get, wrong#args} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    catch {x get a} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodget type selfns win self"}

test tie-file-2.1 {file get} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    set res [dictsort [x get]]
    x destroy
    removeFile journal
    set res
} {a 1 b 2}


test tie-file-3.0 {file set, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x set} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodset type selfns win self dict"}

test tie-file-3.1 {file set, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x set a b} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodset type selfns win self dict"}

test tie-file-3.2 {file set} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x set {c 3 b 2 a 1}]
    lappend res [viewFile journal]
    x destroy
    removeFile journal
    set res
} {{} {
array set {c 3 b 2 a 1}}}


test tie-file-4.0 {file names, wrong#args} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    catch {x names a} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodnames type selfns win self"}

test tie-file-4.1 {file names} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    set res [lsort [x names]]
    x destroy
    removeFile journal
    set res
} {a b}


test tie-file-5.0 {file size, wrong#args} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    catch {x size a} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodsize type selfns win self"}

test tie-file-5.1 {file size} {
    set f [makeFile {array set {b 2 a 1}} journal]
    tie::std::file x $f
    set res [x size]
    x destroy
    removeFile journal
    set res
} 2


test tie-file-6.0 {file unset, wrong#args} {
    set f [makeFile {array set {foo bar fox snarf a 3}} journal]
    tie::std::file x $f
    set     res {}
    catch {x unset a b} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodunset type selfns win self ?pattern?"}

test tie-file-6.1 {file unset, default pattern} {
    set f [makeFile {array set {foo bar fox snarf a 3}} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x unset]
    lappend res [viewFile journal]
    x destroy
    removeFile journal
    set res
} {{} {array set {foo bar fox snarf a 3}
array unset *}}

test tie-file-6.2 {file unset, by pattern} {
    set f [makeFile {array set {foo bar fox snarf a 3}} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x unset f*]
    lappend res [viewFile journal]
    x destroy
    removeFile journal
    set res
} {{} {array set {foo bar fox snarf a 3}
array unset f*}}


test tie-file-7.0 {file getv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x getv} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodgetv type selfns win self index"}

test tie-file-7.1 {file getv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x getv a b} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodgetv type selfns win self index"}

test tie-file-7.2 {file getv} {
    set f [makeFile {array set {a 3 b 4}} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x getv a]
    x destroy
    removeFile journal
    set res
} 3


test tie-file-8.0 {file setv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x setv} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}

test tie-file-8.1 {file setv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x setv a} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}

test tie-file-8.2 {file setv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x setv a b c} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}

test tie-file-8.3 {file setv} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x setv fox snarf]
    lappend res [viewFile journal]
    x destroy
    removeFile journal
    set res
} {{} {
set fox snarf}}


test tie-file-9.0 {file unsetv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x unsetv} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodunsetv type selfns win self index"}

test tie-file-9.1 {file unsetv, wrong#args} {
    set f [makeFile {} journal]
    tie::std::file x $f
    set     res {}
    catch {x unsetv a b} msg
    x destroy
    removeFile journal
    set msg
} {wrong # args: should be "::tie::std::file::Snit_methodunsetv type selfns win self index"}

test tie-file-9.2 {file unsetv} {
    set f [makeFile {array set {a 3 b 4}} journal]
    tie::std::file x $f
    set     res {}
    lappend res [x unsetv a]
    lappend res [viewFile journal]
    x destroy
    removeFile journal
    set res
} {{} {array set {a 3 b 4}
unset a}}

# -------------------------------------------------------------------------
## File compaction

test tie-file-10.0 {file compaction} {
    set f [makeFile {
	set aa 3
	set ab 4
	set ac 5
	set ad 6
	set ae 7
	set f 8
	array unset a*
    } journal] ; # {}
    tie::std::file x $f
    x names ; # This loads the journal and causes compaction
    x destroy
    set res [viewFile journal]
    removeFile journal
    set res
} {array set {f 8}}

test tie-file-10.1 {file compaction, not} {
    set f [makeFile {
	set aa 3
	set ab 4
	set ac 5
	set ad 6
	set ae 7
    } journal] ; # {}
    tie::std::file x $f
    x names ; # This loads the journal and causes compaction
    x destroy
    set res [viewFile journal]
    removeFile journal
    set res
} {
	set aa 3
	set ab 4
	set ac 5
	set ad 6
	set ae 7
    }

::tcltest::cleanupTests
return