Artifact 7d4b849665b953e0c3928b79ade67c18d257c0fd
File
tools/cvs2fossil/lib/c2f_cyclebreaker.tcl
part of check-in
[7f15be9078]
- Added the ability to export the changeset graphs processed by the passes 6 to 8 using GraphViz's dot-format. This is activated by using the switch '--dots'. Bugfixes in the cycle breaker. First corrected variable names, I forgot to use the standard 'myXXX' format for the typevariables. Second, fixed a bug uncovered by looking at the exported graphs, which caused the system to loose arcs, possibly breaking cycles without actually breaking them, leaving them in the dependencies.
by
aku on
2007-11-20 06:59:03.
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################
## This file provides a helper package for the passes 6 and 7 which
## contains the common code of the cycle breaking algorithm.
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require struct::graph ; # Graph handling.
package require struct::list ; # Higher order list operations.
package require vc::tools::dot ; # User feedback. DOT export.
package require vc::tools::log ; # User feedback.
package require vc::tools::misc ; # Text formatting.
package require vc::fossil::import::cvs::project::rev ; # Project level changesets
package require vc::fossil::import::cvs::project::revlink ; # Cycle links.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::cyclebreaker {
# # ## ### ##### ######## #############
## Public API
typemethod dotsto {path} {
::variable mydotdestination $path
return
}
typemethod dot {label changesets} {
::variable mydotprefix $label
::variable mydotid 0
set dg [Setup $changesets 0]
Mark $dg
$dg destroy
return
}
typemethod run {label changesets {savecmd {}}} {
::variable mysave $savecmd
::variable myat 0
::variable mydotprefix $label
::variable mydotid 0
# We create a graph of the revision changesets, using the file
# level dependencies to construct a first approximation of the
# dependencies at the project level. Then we look for cycles
# in that graph and break them.
# 1. Create nodes for all relevant changesets and a mapping
# from the revisions to their changesets/nodes.
set dg [Setup $changesets]
# 3. Lastly we iterate the graph topologically. We mark off
# the nodes which have no predecessors, in order from
# oldest to youngest, saving and removing dependencies. If
# we find no nodes without predecessors we have a cycle,
# and work on breaking it.
log write 3 cyclebreaker {Now sorting the changesets, breaking cycles}
InitializeCandidates $dg
while {1} {
while {[WithoutPredecessor $dg n]} {
SaveAndRemove $dg $n
}
if {![llength [dg nodes]]} break
BreakCycle $dg [FindCycle $dg]
InitializeCandidates $dg
}
dg destroy
log write 3 cyclebreaker Done.
return
}
# # ## ### ##### ######## #############
## Internal methods
proc Setup {changesets {log 1}} {
if {$log} {
log write 3 cyclebreaker "Creating changeset graph, filling with nodes"
log write 3 cyclebreaker "Adding [nsp [llength $changesets] node]"
}
set dg [struct::graph dg]
foreach cset $changesets {
$dg node insert $cset
$dg node set $cset timerange [$cset timerange]
}
# 2. Find for all relevant changeset their revisions and their
# dependencies. Map the latter back to changesets and
# construct the corresponding arcs.
if {$log} {
log write 3 cyclebreaker {Setting up node dependencies}
}
foreach cset $changesets {
foreach succ [$cset successors] {
# Changesets may have dependencies outside of the
# chosen set. These are ignored
if {![$dg node exists $succ]} continue
$dg arc insert $cset $succ
}
}
return $dg
}
# Instead of searching the whole graph for the degree-0 nodes in
# each iteration we compute the list once to start, and then only
# update it incrementally based on the outgoing neighbours of the
# node chosen for commit.
proc InitializeCandidates {dg} {
# bottom = list (list (node, range min, range max))
::variable mybottom
foreach n [$dg nodes] {
if {[$dg node degree -in $n]} continue
lappend mybottom [linsert [$dg node get $n timerange] 0 $n]
}
set mybottom [lsort -index 1 -integer [lsort -index 2 -integer $mybottom]]
return
}
proc WithoutPredecessor {dg nv} {
::variable mybottom
upvar 1 $nv n
if {![llength $mybottom]} { return 0 }
set n [lindex [lindex $mybottom 0] 0]
set mybottom [lrange $mybottom 1 end]
set changed 0
# Update list of nodes without predecessor, based on the
# outgoing neighbours of the chosen node. This should be
# faster than iterating of the whole set of nodes, finding all
# without predecessors, sorting them by time, etc. pp.
foreach out [$dg nodes -out $n] {
if {[$dg node degree -in $out] > 1} continue
# Degree-1 neighbour, will have no predecessors after the
# removal of n. Put on the list.
lappend mybottom [linsert [$dg node get $out timerange] 0 $out]
set changed 1
}
if {$changed} {
set mybottom [lsort -index 1 -integer [lsort -index 2 -integer $mybottom]]
}
# We do not delete the node immediately, to allow the Save
# procedure to save the dependencies as well (encoded in the
# arcs).
return 1
}
proc SaveAndRemove {dg n} {
::variable myat
::variable mysave
# Give the user of the cycle breaker the opportunity to work
# with the changeset before it is removed from the graph.
if {[llength $mysave]} {
uplevel #0 [linsert $mysave end $myat $n]
}
incr myat
$dg node delete $n
return
}
proc FindCycle {dg} {
# This procedure is run if and only the graph is not empty and
# all nodes have predecessors. This means that each node is
# either part of a cycle or (indirectly) depending on a node
# in a cycle. We can start at an arbitrary node, follow its
# incoming edges to its predecessors until we see a node a
# second time. That node closes the cycle and the beginning is
# its first occurence. Note that we can choose an arbitrary
# predecessor of each node as well, we do not have to search.
# We record for each node the index of the first appearance in
# the path, making it easy at the end to cut the cycle from
# it.
# Choose arbitrary node to start our search at.
set start [lindex [$dg nodes] 0]
# Initialize state, path of seen nodes, and when seen.
set path {}
array set seen {}
while {1} {
# Stop searching when we have seen the current node
# already, the circle has been closed.
if {[info exists seen($start)]} break
lappend path $start
set seen($start) [expr {[llength $path]-1}]
# Choose arbitrary predecessor
set start [lindex [$dg nodes -in $start] 0]
}
return [struct::list reverse [lrange $path $seen($start) end]]
}
proc ID {cset} { return "<[$cset id]>" }
proc BreakCycle {dg cycle} {
# The cycle we have gotten is broken by breaking apart one or
# more of the changesets in the cycle. This causes us to
# create one or more changesets which are to be committed,
# added to the graph, etc. pp.
set cprint [join [struct::list map $cycle [myproc ID]] { }]
lappend cycle [lindex $cycle 0] [lindex $cycle 1]
set bestlink {}
set bestnode {}
foreach \
prev [lrange $cycle 0 end-2] \
cset [lrange $cycle 1 end-1] \
next [lrange $cycle 2 end] {
# Each triple PREV -> CSET -> NEXT of changesets, a
# 'link' in the cycle, is analysed and the best
# location where to at least weaken the cycle is
# chosen for further processing.
set link [project::revlink %AUTO% $prev $cset $next]
if {$bestlink eq ""} {
set bestlink $link
set bestnode $cset
} elseif {[$link betterthan $bestlink]} {
$bestlink destroy
set bestlink $link
set bestnode $cset
} else {
$link destroy
}
}
log write 5 breakrcycle "Breaking cycle ($cprint) by splitting changeset <[$bestnode id]>"
set ID [$bestnode id]
Mark $dg -${ID}-before
set newcsets [$bestlink break]
$bestlink destroy
# At this point the old changeset (BESTNODE) is gone
# already. We remove it from the graph as well and then enter
# the fragments generated for it.
# NOTE. We have to get the list of incoming neighbours and
# recompute their successors after the new nodes have been
# inserted. Their outgoing arcs will now go to one or both of
# the new nodes, and not redoing them may cause us to forget
# circles, leaving them in, unbroken.
set pre [$dg nodes -in $bestnode]
$dg node delete $bestnode
foreach cset $newcsets {
$dg node insert $cset
$dg node set $cset timerange [$cset timerange]
}
foreach cset $newcsets {
foreach succ [$cset successors] {
# The new changesets may have dependencies outside of
# the chosen set. These are ignored
if {![$dg node exists $succ]} continue
$dg arc insert $cset $succ
}
}
foreach cset $pre {
foreach succ [$cset successors] {
# Note that the arc may already exist in the graph. If
# so ignore it. The new changesets may have
# dependencies outside of the chosen set. These are
# ignored
if {![$dg node exists $succ]} continue
if {[HasArc $dg $cset $succ]} continue;# TODO should be graph method.
$dg arc insert $cset $succ
}
}
Mark $dg -${ID}-after
return
}
# TODO: This should be a graph method.
proc HasArc {dg a b} {
#8.5: return [expr {$b in [$dg nodes -out $a]}]
if {[lsearch -exact [$dg nodes -out $a] $b] < 0} { return 0 }
return 1
}
proc Mark {dg {suffix {}}} {
::variable mydotdestination
if {$mydotdestination eq ""} return
::variable mydotprefix
::variable mydotid
set fname $mydotdestination/${mydotprefix}${mydotid}${suffix}.dot
file mkdir [file dirname $fname]
dot write $dg $mydotprefix$suffix $fname
incr mydotid
log write 5 cyclebreaker ".dot export $fname"
return
}
typevariable myat 0 ; # Counter for commit ids for the changesets.
typevariable mybottom {} ; # List of candidate nodes for committing.
typevariable mysave {} ; # The command to call for each processed node
typevariable mydotdestination {} ; # Destination directory for .dot files.
typevariable mydotprefix {} ; # Prefix for dot files when exporting the graphs.
typevariable mydotid 0 ; # Counter for dot file name generation.
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
}
namespace eval ::vc::fossil::import::cvs {
namespace export cyclebreaker
namespace eval cyclebreaker {
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::rev
namespace import ::vc::fossil::import::cvs::project::revlink
}
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::log
namespace import ::vc::tools::dot
log register cyclebreaker
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::cyclebreaker 1.0
return