# -*- tcl -*-
# graph.testsupport:  Helper commands for the testsuite.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
#
# All rights reserved.
#
# RCS: @(#) $Id: Xsupport,v 1.1 2006/11/16 06:33:13 andreas_kupries Exp $

# -------------------------------------------------------------------------

# Validate a serialization against the graph it was generated from.

proc validate_serial {g serial {nodes {}}} {
    # Need a list with length a multiple of 3, plus one.

    if {[llength $serial] % 3 != 1} {
	return serial/wrong#elements
    }

    set gattr [lindex $serial end]
    if {[llength $gattr] % 2} {
	return attr/graph/wrong#elements
    }
    if {![string equal \
	    [dictsort $gattr] \
	    [dictsort [$g getall]]]} {
	return attr/graph/data-mismatch
    }

    # Check node attrs and arcs information
    array set an {}
    array set ne {}
    foreach {node attr arcs} [lrange $serial 0 end-1] {
	# Must not list nodes outside of origin
	if {![$g node exists $node]} {
	    return node/$node/unknown
	}
	# Node structure correct ?
	if {[llength $attr] % 2} {
	    return node/$node/attr/wrong#elements
	}
	# Node attribues matching ?
	if {![string equal \
		[dictsort $attr] \
		[dictsort [$g node getall $node]]]} {
	    return node/$node/attr/data-mismatch
	}
	# Remember nodes for reverse check.
	set ne($node) .

	# Go through the attached arcs.
	foreach a $arcs {
	    # Structure correct ?
	    if {[llength $a] != 3} {
		return node/$node/arc/wrong#elements
	    }
	    # Decode structure
	    foreach {arc dst aattr} $a break
	    # Already handled ?
	    if {[info exists an($arc)]} {
		return arc/$arc/duplicate-definition
	    }
	    # Must not list arc outside of origin
	    if {![$g arc exists $arc]} {
		return arc/$arc/unknown
	    }
	    # Attribute structure correct ?
	    if {[llength $aattr] % 2} {
		return arc/$arc/attr/wrong#elements
	    }
	    # Attribute data correct ?
	    if {![string equal \
		    [dictsort $aattr] \
		    [dictsort [$g arc getall $arc]]]} {
		return arc/$arc/attr/data-mismatch
	    }
	    # Arc information, node reference ok ?
	    if {![string is integer -strict $dst]} {
		return arc/$arc/dst/not-an-integer
	    }
	    if {$dst < 0} {
		return arc/$arc/dst/out-of-bounds
	    }
	    if {$dst >= [llength $serial]} {
		return arc/$arc/dts/out-of-bounds
	    }
	    # Arc information matching origin ?
	    if {![string equal $node [$g arc source $arc]]} {
		return arc/$arc/src/mismatch/$node/[$g arc source $arc]
	    }
	    if {![string equal [lindex $serial $dst] [$g arc target $arc]]} {
		return arc/$arc/dst/mismatch/$node/[$g arc target $arc]
	    }
	    # Remember for check for multiples
	    set an($arc) .
	}
    }

    # Nodes ... All must exist in graph ...
    #       ... Spanning nodes have to be in serialization

    if {[llength $nodes] == 0} {
	set nodes [lsort [$g nodes]]
    } else {
	set nodes [lsort $nodes]
    }

    # Reverse check ...
    if {[array size ne] != [llength $nodes]} {
	return nodes/mismatch/#nodes
    }
    if {![string equal [lsort [array names ne]] $nodes]} {
	return nodes/mismatch/data
    }

    # Arcs ... All must exist in graph ...
    #      ... src / dst has to exist, has to match data in graph.
    #      ... All arcs between nodes in 'n' have to be in 'a'

    foreach k [$g arcs] {
	set s [$g arc source $k]
	set e [$g arc target $k]
	if {[info exists ne($s)] && [info exists ne($e)] && ![info exists an($k)]} {
	    return arc/$k/missing/should-have-been-listed
	}
    }

    return ok
}

#----------------------------------------------------------------------

proc SETUP {{g mygraph}} {
    catch {$g destroy}
    graph $g
}

#----------------------------------------------------------------------

proc SETUPx {} {
    SETUP

    mygraph node insert %0 %1 %2 %3 %4 %5
    mygraph node set    %0 volume 30
    mygraph node set    %5 volume 50

    mygraph arc insert %0 %1 0 ; mygraph arc set 0 volume 30
    mygraph arc insert %0 %2 1
    mygraph arc insert %0 %3 2
    mygraph arc insert %3 %4 3
    mygraph arc insert %4 %5 4
    mygraph arc insert %5 %3 5 ; mygraph arc set 5 volume 50
}

#----------------------------------------------------------------------

proc SETUPwalk {} {
    SETUP
    mygraph node insert i ii iii iv v vi vii viii ix
    mygraph arc insert   i    ii  1
    mygraph arc insert   ii  iii  2
    mygraph arc insert   ii  iii  3
    mygraph arc insert   ii  iii  4
    mygraph arc insert  iii   iv  5
    mygraph arc insert  iii   iv  6
    mygraph arc insert   iv    v  7
    mygraph arc insert    v   vi  8
    mygraph arc insert   vi viii  9
    mygraph arc insert viii    i 10
    mygraph arc insert    i   ix 11
    mygraph arc insert   ix   ix 12
    mygraph arc insert    i  vii 13
    mygraph arc insert  vii   vi 14
}

#----------------------------------------------------------------------
# Generators for various error messages generated
# by the implementations.

proc MissingArc  {g a} {return "arc \"$a\" does not exist in graph \"$g\""}
proc MissingNode {g n} {return "node \"$n\" does not exist in graph \"$g\""}

proc ExistingArc  {g a} {return "arc \"$a\" already exists in graph \"$g\""}
proc ExistingNode {g n} {return "node \"$n\" already exists in graph \"$g\""}

proc MissingKey {e type k} {return "invalid key \"$k\" for $type \"$e\""}

# Fake for graph attribute tests
proc MissingGraph {args} {return {Bogus missing}}

#----------------------------------------------------------------------
