prof_test1   [plain text]

# To do: Should run all tests and return a useful exit status, not
# punt on the first failure.

set wd [pwd]
set verbose 0

proc test1 {} {
    global wd verbose
    set p [profile_init_path $wd/test2.ini]
    set sect {{test section 1} child_section child}
    set iter [profile_iterator_create $p $sect 0]
    set done 0
    if $verbose { puts "Iterating over {$sect} entries:" }
    while {!$done} {
	set pair [profile_iterator $iter]
	if [string match $pair {{} {}}] {
	    set done 1
	} else {
	    set val [lindex $pair 1]
	    if $verbose { puts -nonewline "\t$val" }
	}
    }
    if $verbose { puts "" }
    #profile_iterator_free $iter

    set iter [profile_iterator_create $p $sect 0]
    set done 0
    if $verbose { puts "Iterating again, deleting:" }
    while {!$done} {
	set pair [profile_iterator $iter]
	if [string match $pair {{} {}}] {
	    set done 1
	} else {
	    set val [lindex $pair 1]
	    if $verbose { puts -nonewline "\t$val" }
	    profile_update_relation $p $sect $val
	}
    }
    if $verbose { puts "" }
    #profile_iterator_free $iter
    catch {file delete $wd/test3.ini}
    profile_flush_to_file $p $wd/test3.ini
    profile_release $p

    if $verbose { puts "Reloading new profile" }
    set p [profile_init_path $wd/test3.ini]
    set iter [profile_iterator_create $p $sect 0]
    set done 0
    if $verbose { puts "Iterating again:" }
    set found_some 0
    while {!$done} {
	set pair [profile_iterator $iter]
	if [string match $pair {{} {}}] {
	    set done 1
	} else {
	    set found_some 1
	    set val [lindex $pair 1]
	    if $verbose { puts -nonewline "\t$val" }
	}
    }
    #profile_iterator_free $iter
    profile_abandon $p

    if {$found_some} {
	if $verbose { puts "" }
	puts stderr "Error: Deleting in iterator didn't get them all."
	exit 1
    } else {
	puts "OK: test1: Deleting in iteration got rid of all entries."
    }
}

proc test2 {} {
    global wd verbose

    # lxs said: create A, read A, flush A, read A, create B, read B, crash
    # (where "create" refers to the object, not the file)

    if $verbose { puts "Running test2" }
    set c [profile_init_path $wd/test2.ini]
    # create A
    set a [profile_init_path $wd/test2.ini]
    if $verbose { puts "Opened profile $wd/test2.ini" }
    # read A
    set x [profile_get_values $a {{test section 1} foo}]
    if $verbose { puts "Read $x from profile" }
    if $verbose { puts "updating" }
    exec sleep 2
    profile_update_relation $a {{test section 1} foo} [lindex $x 0] [lindex $x 0]
    set x [profile_get_values $a {{test section 1} foo}]
    if $verbose { puts "Read $x from profile" }
    # flush A
    profile_flush $a
    # read A again
    set x [profile_get_values $a {{test section 1} foo}]
    if $verbose { puts "Read $x from profile" }
    profile_release $a
    # create B
    set b [profile_init_path $wd/test2.ini]
    if $verbose { puts "Opened profile again" }
    # read B
    set x [profile_get_values $b {{test section 1} foo}]
    if $verbose { puts "Read $x from profile" }
    # read B
    set x [profile_get_values $b {{test section 1} foo}]
    if $verbose { puts "Read $x from profile" }
    # If we got this far, now what?
    profile_release $b
    profile_release $c
    puts "OK: test2: Modifications don't corrupt existing open handles"
}

proc test3 {} {
    # lxs said: Start with a relation in the file.  Open, delete
    # relation, add relation back, list relations.  In 1.4 release
    # code, got two back.

    global wd verbose

    exec cp $wd/test2.ini $wd/test1c.ini
    set p [profile_init_path $wd/test1c.ini]
    set sect {{test section 1} quux}

    set v [profile_get_values $p $sect]
    set v1 [lindex $v 0]
    if $verbose { puts "Old values: $v" }
    profile_clear_relation $p $sect
    if $verbose { puts "Cleared." }
    # profile_get_values raises an exception if no data is there; so if
    # it succeeds, the test fails.
    catch {
	set v [profile_get_values $p $sect]
	if $verbose { puts "New values: $v" }
	puts stderr "Error: test3: Clearing relation didn't get rid of all values."
	exit 1
    }
    if $verbose { puts "Adding back $v1 ..." }
    profile_add_relation $p $sect $v1
    set v [profile_get_values $p $sect]
    if $verbose { puts "New values: $v" }
    if [llength $v]!=1 {
	puts stderr "Error: test3: Adding one entry after clearing relation leaves [llength $v] entries."
	exit 1
    }
    profile_abandon $p
    file delete $wd/test1c.ini
    puts "OK: test3: Clearing relation and adding one entry yields correct count."
}

test1
test2
test3

exit 0