path: root/src/util/profile/prof_test1

# 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 two copies of test2.ini inside
    # it and 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/b
    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

    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
    }

    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
    }

    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
    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
    }

    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"
}

test1
test2
test3
test4
test5
test6
test7
test8
test9

exit 0