# testnode.tcl --
#
# Test the detach and isdetached operation on nodes and vertices.
#
# Copyright (c) 2000-2003, JYL Software Inc.
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE, EVEN IF
# JYL SOFTWARE INC. IS MADE AWARE OF THE POSSIBILITY OF SUCH DAMAGE.

# Require the tcltest package:

package require tcltest

# Load some utilities:

source [file join [file dirname [info script]] util.tcl]
    
# The tests:

# Test that the root node is initially detached.

tcltest::test detach-1.0.1 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }
    $x delete
    set empty
} ""

# Test that a sub-node within a node is not detached, and that it is
# detached after calling $n1 detach

tcltest::test detach-1.0.2 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    set n1 [$n addnode foo last]
    if {[$n1 isdetached]} {
	deleteAndError $x "subnode $n1 is detached"
    }

    $n1 detach
    if {![$n1 isdetached]} {
	deleteAndError $x "subnode $n1 is not detached"
    }

    $x delete
    set empty
} ""

# Detaching one node does not affect other nodes.

tcltest::test detach-1.0.3 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    set n1 [$n addnode foo last]
    set n2 [$n addnode foo last]
    if {[$n1 isdetached] || [$n2 isdetached]} {
	deleteAndError $x "subnodes created detached"
    }
    $n1 detach
    if {![$n1 isdetached] || [$n2 isdetached]} {
	deleteAndError $x "detach confusion, [$n1 isdetached] [$n2 isdetached]"
    }

    set nn1 [$n1 addnode foo last]
    if {![$n1 isdetached] || [$nn1 isdetached]} {
	deleteAndError $x \
	    "detach confusion, [$n1 isdetached] [$nn1 isdetached]"
    }

    set n1 nul
    if {![$nn1 isdetached]} {
	deleteAndError $x "subsubnode $nn1 should be detached"
    }

    $x delete
    set empty
} ""

# Vertices within a node are not detached.

tcltest::test detach-1.0.4 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    for {set i 0} {$i < 10} {incr i} {$n add foo$i last $i}
    set v [$n getvertex foo3]

    if {[$v isdetached] || ![string equal $n [$v node]]} {
	deleteAndError $x "vertex $v is initially detached"
    }

    for {set i 0} {$i < 10} {incr i} {$n detachvertex foo$i}

    if {![$v isdetached]} {
	deleteAndError $x "vertex $v did not become detached as expected"
    }

    set v 90
    $x delete
    set empty
} ""

# Vertices within a subnode are not detached initially.

tcltest::test detach-1.0.5 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    for {set i 0} {$i < 10} {incr i} {$n addnode foo last}

    set v [$n getvertex 3]
    set n1 [$v get]

    for {set i 0} {$i < 10} {incr i} {$n1 add foo$i last $i}

    set v1 [$n1 getvertex foo3]

    if {[$v isdetached] || [$n1 isdetached] || [$v1 isdetached]} {
	deleteAndError $x "detach initial state incorrect"
    }

    for {set i 0} {$i < 10} {incr i} {$n detachvertex 1}

    if {![$v isdetached] || ![$n1 isdetached] || [$v1 isdetached]} {
	deleteAndError $x "detach state 1 incorrect"
    }

    for {set i 0} {$i < 10} {incr i} {$n1 detachvertex 1}

    if {![$v isdetached] || ![$n1 isdetached] || ![$v1 isdetached]} {
	deleteAndError $x "detach state 2 incorrect"
    }

    set v 90

    $x delete
    set empty
} ""

# A node can become attached again if it is inserted as the value of a new
# vertex.

tcltest::test detach-1.0.6 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    $n add foo last $n

    if {[$n isdetached]} {
	deleteAndError $x "root $n should now be attached"
    }

    $x delete
    set empty
} ""

# A node can become attached again if it is set as the value of an
# existing vertex.

tcltest::test detach-1.0.1 {detach tests} {
    showActive
    set empty ""
    set x [ensureFreshStorage foo.db]
    set n [$x root]

    if {![$n isdetached]} {
	deleteAndError $x "root $n is not detached initially"
    }

    set n1 [$n addnode bar last]
    if {[$n1 isdetached]} {
	deleteAndError $x "node n1 $n1 should be attached"
    }
    $n detachvertex bar
    if {![$n1 isdetached]} {
	deleteAndError $x "node n1 $n1 should be detached"
    }

    $n add foo last 12
    $n set foo $n

    if {[$n isdetached]} {
	deleteAndError $x "root $n should be attached now"
    }

    $n detachvertex foo

    if {![$n isdetached]} {
	deleteAndError $x "root $n should be detached again"
    }

    $x delete
    set empty
} ""
