# 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