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