# 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_abandon $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."
}
# Exercise the include and includedir directives.
proc test4 {} {
global wd verbose
# Test expected error message when including nonexistent file.
catch [file delete $wd/testinc.ini]
exec echo "include does-not-exist" >$wd/testinc.ini
catch { profile_init_path $wd/testinc.ini } err
if $verbose { puts "Got error message $err" }
if ![string equal $err "Included profile file could not be read"] {
puts stderr "Error: test4: Did not get expected error when including nonexistent file."
exit 1
}
# Test expected error message when including nonexistent directory.
catch [file delete $wd/testinc.ini]
exec echo "includedir does-not-exist" >$wd/testinc.ini
catch { profile_init_path $wd/testinc.ini } err
if $verbose { puts "Got error message $err" }
if ![string equal $err "Included profile directory could not be read"] {
puts stderr "Error: test4: Did not get expected error when including nonexistent directory."
exit 1
}
# Test including a file.
catch [file delete $wd/testinc.ini]
exec echo "include $wd/test2.ini" >$wd/testinc.ini
set p [profile_init_path $wd/testinc.ini]
set x [profile_get_values $p {{test section 1} bar}]
if $verbose { puts "Read $x from included profile" }
if ![string equal [lindex $x 0] "foo"] {
puts stderr "Error: test4: Did not get expected result from included profile."
exit 1
}
profile_release $p
# Test including a directory. Put four copies of test2.ini inside
# the directory, two with invalid names. Check that we get two
# values for one of the variables.
catch [file delete -force $wd/test_include_dir]
exec mkdir $wd/test_include_dir
exec cp $wd/test2.ini $wd/test_include_dir/a
exec cp $wd/test2.ini $wd/test_include_dir/a~
exec cp $wd/test2.ini $wd/test_include_dir/b.conf
exec cp $wd/test2.ini $wd/test_include_dir/b.conf.rpmsave
catch [file delete $wd/testinc.ini]
exec echo "includedir $wd/test_include_dir" >$wd/testinc.ini
set p [profile_init_path $wd/testinc.ini]
set x [profile_get_values $p {{test section 1} bar}]
if $verbose { puts "Read $x from included directory" }
if ![string equal $x "foo foo"] {
puts stderr, "Error: test4: Did not get expected result from included directory."
exit 1
}
profile_release $p
# Directly list the directory in the profile path and try again.
set p [profile_init_path $wd/test_include_dir]
set x [profile_get_values $p {{test section 1} bar}]
if $verbose { puts "Read $x from directory" }
if ![string equal $x "foo foo"] {
puts stderr, "Error: test4: Did not get expected result from directory."
exit 1
}
profile_release $p
puts "OK: test4: include and includedir directives"
}
proc test5 {} {
global wd verbose
# Test syntactic independence of included profile files.
catch [file delete $wd/testinc.ini]
set f [open "$wd/testinc.ini" w]
puts $f {[sec1]}
puts $f "var = {"
puts $f "a = 1"
puts $f "include testinc2.ini"
puts $f "c = 3"
puts $f "}"
close $f
catch [file delete $wd/testinc2.ini]
set f [open "$wd/testinc2.ini" w]
puts $f {[sec2]}
puts $f "b = 2"
close $f
set p [profile_init_path $wd/testinc.ini]
set a [profile_get_values $p {sec1 var a}]
set b [profile_get_values $p {sec2 b}]
set c [profile_get_values $p {sec1 var c}]
if $verbose { puts "Read values [concat $a $b $c] from profile" }
if { $a != 1 || $b != 2 || $c != 3 } {
puts stderr, "Error: test5: Wrong results from profile"
exit 1
}
profile_release $p
puts "OK: test5: syntax independence of included files"
}
proc test6 {} {
global wd verbose
# If a section is deleted and replaced, the new section should be
# used when retrieving values.
set p [profile_init_path $wd/test2.ini]
set sect {{test section 1}}
set newrel [concat $sect testkey]
set oldrel [concat $sect child]
if $verbose { puts "Removing and replacing {$sect}" }
profile_rename_section $p $sect
profile_add_relation $p $sect
if $verbose { puts "Adding {$newrel}" }
profile_add_relation $p $newrel 6
set x [profile_get_values $p $newrel]
if $verbose { puts "Read from new relation {$newrel}: $x" }
if { $x != 6 } {
puts stderr, "Error: test6: Could not get value from new section"
exit 1
}
if $verbose { puts "Reading old relation {$oldrel} which should be gone" }
catch {
profile_get_values $p $oldrel
puts stderr, "Error: test6: Got value from deleted section"
exit 1
}
profile_abandon $p
puts "OK: test6: section replacement"
}
proc test7 {} {
global wd verbose
# A deleted node at the end of a relation's value set should not cause
# profile_clear_relation to error, as long as some value is present.
set p [profile_init_path $wd/test2.ini]
set rel {{test section 1} testkey}
if $verbose { puts "Adding values 1 2 at {$rel}" }
profile_add_relation $p $rel 1
profile_add_relation $p $rel 2
if $verbose { puts "Removing value 2 at {$rel}" }
profile_update_relation $p $rel 2
if $verbose { puts "Clearing values at {$rel}" }
profile_clear_relation $p $rel
profile_abandon $p
puts "OK: test7: profile_clear_relation with deleted node at end"
}
proc test8 {} {
global wd verbose
# Order of relation operations should be reflected even if some of
# the relations were deleted.
set p [profile_init_path $wd/test2.ini]
set rel {{test section 1} testkey}
if $verbose { puts "Adding values 1 2 3 at {$rel}" }
profile_add_relation $p $rel 1
profile_add_relation $p $rel 2
profile_add_relation $p $rel 3
if $verbose { puts "Removing values 2 and adding 4 at {$rel}" }
profile_update_relation $p $rel 2
profile_add_relation $p $rel 4
set x [profile_get_values $p $rel]
if $verbose { puts "Read values from {$rel}: $x" }
if { $x != {1 3 4} } {
puts stderr, "Error: test8: Wrong order of values: $x"
exit 1
}
profile_abandon $p
puts "OK: test8: relation order in the presence of deletions"
}
proc test9 {} {
global wd verbose
# Regression test for #8431: profile_flush_to_file erroneously
# cleared the DIRTY and SHARED flags from the data object, which
# could lead to a dangling reference in g_shared_trees on release.
set p [profile_init_path $wd/test2.ini]
catch {file delete $wd/test3.ini}
profile_flush_to_file $p $wd/test3.ini
profile_release $p
# If a dangling reference was created in g_shared_trees, the next
# profile open will trigger an assertion failure.
set p [profile_init_path $wd/test2.ini]
profile_release $p
puts "OK: test9: profile_flush_to_file with no changes"
}
proc test10 {} {
global wd verbose
# Regression test for #7863: multiply-specified subsections should
# be merged.
set p [profile_init_path $wd/test2.ini]
set x [profile_get_values $p {{test section 2} child_section2 child}]
if $verbose { puts "Read $x from profile" }
if ![string equal $x "slick harry {john\tb } ron"] {
puts stderr "Error: test10: Did not get expected merged children."
exit 1
}
set x [profile_get_string $p {test section 2} child_section2 chores]
if $verbose { puts "Read $x from profile" }
if ![string equal $x "cleaning"] {
puts stderr "Error: test10: Did not find expected chores."
exit 1
}
profile_release $p
}
test1
test2
test3
test4
test5
test6
test7
test8
test9
test10
exit 0