Differences From:
File
tools/cvs2fossil/lib/c2f_pbreakacycle.tcl
part of check-in
[d743f04bd2]
- Moved more parts taken over by the top. sort passes out the breaker passes, and renumbered them.
by
aku on
2007-11-25 03:05:21.
[view]
To:
File
tools/cvs2fossil/lib/c2f_pbreakacycle.tcl
part of check-in
[1ea319fb67]
- Another helper, textual, write changeset data to stdout.
by
aku on
2007-11-25 07:44:24.
[view]
@@ -21,8 +21,9 @@
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require struct::list ; # Higher order list operations.
+package require struct::set ; # Set operations.
package require vc::tools::misc ; # Min, max.
package require vc::tools::log ; # User feedback.
package require vc::tools::trouble ; # Error reporting.
package require vc::fossil::import::cvs::repository ; # Repository management.
@@ -63,9 +64,15 @@
typemethod run {} {
# Pass manager interface. Executed to perform the
# functionality of the pass.
+ set len [string length [project::rev num]]
+ set myatfmt %${len}s
+ incr len 6
+ set mycsfmt %${len}s
+
cyclebreaker precmd [myproc BreakBackwardBranches]
+ cyclebreaker savecmd [myproc KeepOrder]
cyclebreaker breakcmd [myproc BreakCycle]
state transaction {
LoadCommitOrder
@@ -89,14 +96,16 @@
proc Changesets {} { project::rev all }
proc LoadCommitOrder {} {
::variable mycset
+ ::variable myrevisionchangesets
state transaction {
foreach {cid pos} [state run { SELECT cid, pos FROM csorder }] {
set cset [project::rev of $cid]
$cset setpos $pos
set mycset($pos) $cset
+ lappend myrevisionchangesets $cset
}
# Remove the order information now that we have it in
# memory, so that we can save it once more, for all
# changesets, while breaking the remaining cycles.
@@ -302,10 +311,185 @@
# # ## ### ##### ######## #############
+ proc KeepOrder {graph at cset} {
+ set cid [$cset id]
+
+ log write 4 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>"
+
+ # We see here a mixture of symbol and revision changesets.
+ # The symbol changesets are ignored as irrelevant.
+
+ if {[$cset pos] eq ""} return
+
+ # For the revision changesets we are sure that they are
+ # consumed in the same order as generated by pass 7
+ # (RevTopologicalSort). Per the code in cvs2svn.
+
+ # NOTE: I cannot see that. Assume cs A and cs B, not dependent
+ # on each other in the set of revisions, now B after A
+ # simply means that B has a later time or depends on
+ # something wit a later time than A. In the full graph A
+ # may now have dependencies which shift it after B,
+ # violating the above assumption.
+ #
+ # Well, it seems to work if I do not make the NTDB root a
+ # successor of the regular root. Doing so seems to tangle the
+ # changesets into a knots regarding time vs dependencies and
+ # trigger such shifts. Keeping these two roots separate OTOH
+ # disappears the tangle. So, for now I accept that, and for
+ # paranoia I add code which checks this assumption.
+
+ struct::set exclude myrevisionchangesets $cset
+
+ ::variable mylastpos
+ set new [$cset pos]
+
+ if {$new != ($mylastpos + 1)} {
+ if {$mylastpos < 0} {
+ set old "<NONE>"
+ } else {
+ ::variable mycset
+ set old [$mycset($mylastpos) str]@$mylastpos
+ }
+
+ trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old"
+ }
+
+ set mylastpos $new
+ return
+ }
+
+ proc FormatTR {graph cset} {
+ return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }]
+ }
+
+ typevariable mylastpos -1 ; # Position of last revision changeset saved.
+ typevariable myrevisionchangesets {} ; # Set of revision changesets
+
+ typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
+ typevariable mycsfmt ; # Ditto for the changesets.
+
+ # # ## ### ##### ######## #############
+
proc BreakCycle {graph} {
+ # In this pass the cycle breaking can be made a bit more
+ # targeted, hence this custom callback.
+ #
+ # First we use the data remembered by 'SaveOrder', about the
+ # last commit position it handled, to deduce the next revision
+ # changeset it would encounter. Then we look for the shortest
+ # predecessor path from it to all other revision changesets
+ # and break this path. Without such a path we fall back to the
+ # generic cycle breaker.
+
+ ::variable mylastpos
+ ::variable mycset
+ ::variable myrevisionchangesets
+
+ set nextpos [expr {$mylastpos + 1}]
+ set next $mycset($nextpos)
+
+ puts "** Last: $mylastpos = [$mycset($mylastpos) str] @ [$mycset($mylastpos) pos]"
+ puts "** Next: $nextpos = [$next str] @ [$next pos]"
+
+ set path [SearchForPath $graph $next $myrevisionchangesets]
+ if {[llength $path]} {
+ cyclebreaker break-segment $graph $path
+ return
+ }
+
+ # We were unable to find an ordered changeset in the reachable
+ # predecessors, fall back to the generic code for breaking the
+ # found cycle.
+
cyclebreaker break $graph
+ }
+
+ proc SearchForPath {graph n stopnodes} {
+ # Search for paths to prerequisites of N.
+ #
+ # Try to find the shortest dependency path that causes the
+ # changeset N to depend (directly or indirectly) on one of the
+ # changesets contained in STOPNODES.
+ #
+ # We consider direct and indirect dependencies in the sense
+ # that the changeset can be reached by following a chain of
+ # predecessor nodes.
+ #
+ # When one of the csets in STOPNODES is found, we terminate
+ # the search and return the path from that cset to N. If no
+ # path is found to a node in STOP_SET, we return the empty
+ # list/path.
+
+ # This is in essence a multi-destination Dijkstra starting at
+ # N which stops when one of the destinations in STOPNODES has
+ # been reached, traversing the predecessor arcs.
+
+ # REACHABLE :: array (NODE -> list (STEPS, PREVIOUS))
+ #
+ # Semantics: NODE can be reached from N in STEPS steps, and
+ # PREVIOUS is the previous node in the path which reached it,
+ # allowing us at the end to construct the full path by
+ # following these backlinks from the found destination. N is
+ # only included as a key if there is a loop leading back to
+ # it.
+
+ # PENDING :: list (list (NODE, STEPS))
+ #
+ # Semantics: A list of possibilities that still have to be
+ # investigated, where STEPS is the number of steps to get to
+ # NODE.
+
+ array set reachable {}
+ set pending [list [list $n 0]]
+ set at 0
+
+ puts "** Searching shortest path ..."
+
+ while {$at < [llength $pending]} {
+ struct::list assign [lindex $pending $at] current steps
+
+ #puts "** [lindex $pending $at] ** [$current str] **"
+ incr at
+
+ # Process the possibility. This is a breadth-first traversal.
+ incr steps
+ foreach pre [$graph nodes -in $current] {
+ # Since the search is breadth-first, we only have to #
+ # set nodes that don't already exist. If they do they
+ # have been reached already on a shorter path.
+
+ if {[info exists reachable($pre)]} continue
+
+ set reachable($pre) [list $steps $current]
+ lappend pending [list $pre $steps]
+
+ # Continue the search while have not reached any of
+ # our destinations?
+ if {![struct::set contain $pre $stopnodes]} continue
+
+ # We have arrived, PRE is one of the destination; now
+ # construct and return the path to it from N by
+ # following the backlinks in the search state.
+ set path [list $pre]
+ while {1} {
+ set pre [lindex $reachable($pre) 1]
+ if {$pre eq $n} break
+ lappend path $pre
+ }
+ lappend path $n
+
+ puts "** Searching shortest path ... Found ([project rev strlist $path])"
+ return $path
+ }
+ }
+
+ puts "** Searching shortest path ... Not found"
+
+ # No path found.
+ return {}
}
# # ## ### ##### ######## #############