e7c805f137 2007-11-16 aku: ## -*- tcl -*- e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: ## Copyright (c) 2007 Andreas Kupries. e7c805f137 2007-11-16 aku: # e7c805f137 2007-11-16 aku: # This software is licensed as described in the file LICENSE, which e7c805f137 2007-11-16 aku: # you should have received as part of this distribution. e7c805f137 2007-11-16 aku: # e7c805f137 2007-11-16 aku: # This software consists of voluntary contributions made by many e7c805f137 2007-11-16 aku: # individuals. For exact contribution history, see the revision e7c805f137 2007-11-16 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: d743f04bd2 2007-11-25 aku: ## Pass IX. This is the final pass for breaking changeset dependency d743f04bd2 2007-11-25 aku: ## cycles. The previous breaker passes (6 and 8) broke cycles covering d743f04bd2 2007-11-25 aku: ## revision and symbol changesets, respectively. This pass now breaks d743f04bd2 2007-11-25 aku: ## any remaining cycles, each of which has to contain at least one d743f04bd2 2007-11-25 aku: ## revision and at least one symbol changeset. e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: ## Requirements e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: package require Tcl 8.4 ; # Required runtime. e7c805f137 2007-11-16 aku: package require snit ; # OO system. e7c805f137 2007-11-16 aku: package require struct::list ; # Higher order list operations. 1ea319fb67 2007-11-25 aku: package require struct::set ; # Set operations. 4866889e88 2007-11-22 aku: package require vc::tools::misc ; # Min, max. e7c805f137 2007-11-16 aku: package require vc::tools::log ; # User feedback. 4866889e88 2007-11-22 aku: package require vc::tools::trouble ; # Error reporting. 1f60018119 2007-11-21 aku: package require vc::fossil::import::cvs::repository ; # Repository management. e7c805f137 2007-11-16 aku: package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles. e7c805f137 2007-11-16 aku: package require vc::fossil::import::cvs::state ; # State storage. bf83201c7f 2007-11-27 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. e7c805f137 2007-11-16 aku: package require vc::fossil::import::cvs::project::rev ; # Project level changesets e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: ## Register the pass with the management e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: vc::fossil::import::cvs::pass define \ e7c805f137 2007-11-16 aku: BreakAllCsetCycles \ e7c805f137 2007-11-16 aku: {Break Remaining ChangeSet Dependency Cycles} \ e7c805f137 2007-11-16 aku: ::vc::fossil::import::cvs::pass::breakacycle e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: ## e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: snit::type ::vc::fossil::import::cvs::pass::breakacycle { e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# e7c805f137 2007-11-16 aku: ## Public API e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: typemethod setup {} { e7c805f137 2007-11-16 aku: # Define the names and structure of the persistent state of e7c805f137 2007-11-16 aku: # this pass. de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: state reading csorder e7c805f137 2007-11-16 aku: return e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: typemethod load {} { e7c805f137 2007-11-16 aku: # Pass manager interface. Executed to load data computed by e7c805f137 2007-11-16 aku: # this pass into memory when this pass is skipped instead of e7c805f137 2007-11-16 aku: # executed. e7c805f137 2007-11-16 aku: return e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: typemethod run {} { e7c805f137 2007-11-16 aku: # Pass manager interface. Executed to perform the e7c805f137 2007-11-16 aku: # functionality of the pass. 7f15be9078 2007-11-20 aku: 1ea319fb67 2007-11-25 aku: set len [string length [project::rev num]] 1ea319fb67 2007-11-25 aku: set myatfmt %${len}s 1ea319fb67 2007-11-25 aku: incr len 6 1ea319fb67 2007-11-25 aku: set mycsfmt %${len}s 1ea319fb67 2007-11-25 aku: 4f1b60dd16 2007-11-22 aku: cyclebreaker precmd [myproc BreakBackwardBranches] 1ea319fb67 2007-11-25 aku: cyclebreaker savecmd [myproc KeepOrder] 1f60018119 2007-11-21 aku: cyclebreaker breakcmd [myproc BreakCycle] 1f60018119 2007-11-21 aku: 1f60018119 2007-11-21 aku: state transaction { de4cff4142 2007-11-22 aku: LoadCommitOrder 1f60018119 2007-11-21 aku: cyclebreaker run break-all [myproc Changesets] bf83201c7f 2007-11-27 aku: bf83201c7f 2007-11-27 aku: repository printcsetstatistics bf83201c7f 2007-11-27 aku: integrity changesets bf83201c7f 2007-11-27 aku: } e7c805f137 2007-11-16 aku: return e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: typemethod discard {} { e7c805f137 2007-11-16 aku: # Pass manager interface. Executed for all passes after the e7c805f137 2007-11-16 aku: # run passes, to remove all data of this pass from the state, e7c805f137 2007-11-16 aku: # as being out of date. e7c805f137 2007-11-16 aku: return e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# e7c805f137 2007-11-16 aku: ## Internal methods e7c805f137 2007-11-16 aku: 2a0ec504c5 2007-11-21 aku: proc Changesets {} { project::rev all } 2a0ec504c5 2007-11-21 aku: de4cff4142 2007-11-22 aku: proc LoadCommitOrder {} { de4cff4142 2007-11-22 aku: ::variable mycset 1ea319fb67 2007-11-25 aku: ::variable myrevisionchangesets de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: state transaction { de4cff4142 2007-11-22 aku: foreach {cid pos} [state run { SELECT cid, pos FROM csorder }] { de4cff4142 2007-11-22 aku: set cset [project::rev of $cid] de4cff4142 2007-11-22 aku: $cset setpos $pos de4cff4142 2007-11-22 aku: set mycset($pos) $cset 1ea319fb67 2007-11-25 aku: lappend myrevisionchangesets $cset de4cff4142 2007-11-22 aku: } de4cff4142 2007-11-22 aku: # Remove the order information now that we have it in de4cff4142 2007-11-22 aku: # memory, so that we can save it once more, for all de4cff4142 2007-11-22 aku: # changesets, while breaking the remaining cycles. de4cff4142 2007-11-22 aku: state run { DELETE FROM csorder } de4cff4142 2007-11-22 aku: } de4cff4142 2007-11-22 aku: return de4cff4142 2007-11-22 aku: } de4cff4142 2007-11-22 aku: 1f60018119 2007-11-21 aku: # # ## ### ##### ######## ############# 1f60018119 2007-11-21 aku: 4f1b60dd16 2007-11-22 aku: proc BreakBackwardBranches {graph} { 4866889e88 2007-11-22 aku: # We go over all branch changesets, i.e. the changesets 4866889e88 2007-11-22 aku: # created by the symbols which are translated as branches, and 4f1b60dd16 2007-11-22 aku: # break any which are 'backward', which means that they have 4f1b60dd16 2007-11-22 aku: # at least one incoming revision changeset which is committed 4f1b60dd16 2007-11-22 aku: # after at least one of the outgoing revision changesets, per 4f1b60dd16 2007-11-22 aku: # the order computed in pass 6. In "cvs2svn" this is called 4f1b60dd16 2007-11-22 aku: # "retrograde". 4866889e88 2007-11-22 aku: 4866889e88 2007-11-22 aku: # NOTE: We might be able to use our knowledge that we are 4866889e88 2007-11-22 aku: # looking at all changesets to create a sql which selects all 4866889e88 2007-11-22 aku: # the branch changesets from the state in one go instead of 4866889e88 2007-11-22 aku: # having to check each changeset separately. Consider this 4866889e88 2007-11-22 aku: # later, get the pass working first. 4866889e88 2007-11-22 aku: # e50f9ed55e 2007-11-22 aku: # NOTE 2: Might we even be able to select the backward branch 4866889e88 2007-11-22 aku: # changesets too ? 4866889e88 2007-11-22 aku: 4866889e88 2007-11-22 aku: foreach cset [$graph nodes] { 4866889e88 2007-11-22 aku: if {![$cset isbranch]} continue 4f1b60dd16 2007-11-22 aku: CheckAndBreakBackwardBranch $graph $cset 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: return 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: proc CheckAndBreakBackwardBranch {graph cset} { 4f1b60dd16 2007-11-22 aku: while {[IsABackwardBranch $graph $cset]} { 87cf609021 2007-11-24 aku: log write 5 breakacycle "Breaking backward branch changeset [$cset str]" e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Knowing that the branch is backward we now look at the e50f9ed55e 2007-11-22 aku: # individual revisions in the changeset and determine e50f9ed55e 2007-11-22 aku: # which of them are responsible for the overlap. This e50f9ed55e 2007-11-22 aku: # allows us to split them into two sets, one of e50f9ed55e 2007-11-22 aku: # non-overlapping revisions, and of overlapping ones. Each e50f9ed55e 2007-11-22 aku: # induces a new changeset, and the second may still be e50f9ed55e 2007-11-22 aku: # backward and need further splitting. Hence the looping. e50f9ed55e 2007-11-22 aku: # e50f9ed55e 2007-11-22 aku: # The border used for the split is the minimal commit e50f9ed55e 2007-11-22 aku: # position among the minimal sucessor commit positions for e50f9ed55e 2007-11-22 aku: # the revisions in the changeset. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Note that individual revisions may not have revision e50f9ed55e 2007-11-22 aku: # changesets are predecessors and/or successors, leaving e50f9ed55e 2007-11-22 aku: # the limits partially or completely undefined. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # limits : dict (revision -> list (max predecessor commit, min sucessor commit)) e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: ComputeLimits $cset limits border e50f9ed55e 2007-11-22 aku: 6d63634309 2007-11-24 aku: log write 6 breakacycle "Using commit position $border as border" e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Then we sort the file level items based on there they e50f9ed55e 2007-11-22 aku: # sit relative to the border into before and after the e50f9ed55e 2007-11-22 aku: # border. e50f9ed55e 2007-11-22 aku: 6d63634309 2007-11-24 aku: SplitRevisions $limits $border normalrevisions backwardrevisions e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: set replacements [project::rev split $cset $normalrevisions $backwardrevisions] e50f9ed55e 2007-11-22 aku: cyclebreaker replace $graph $cset $replacements e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # At last check that the normal frament is indeed not e50f9ed55e 2007-11-22 aku: # backward, and iterate over the possibly still backward e50f9ed55e 2007-11-22 aku: # second fragment. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: struct::list assign $replacements normal backward 6d63634309 2007-11-24 aku: if {[IsABackwardBranch $graph $normal]} { trouble internal "The normal fragment is unexpectedly a backward branch" } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: set cset $backward 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: return 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: proc IsABackwardBranch {dg cset} { 4f1b60dd16 2007-11-22 aku: # A branch is "backward" if it has at least one incoming 4f1b60dd16 2007-11-22 aku: # revision changeset which is committed after at least one of 4f1b60dd16 2007-11-22 aku: # the outgoing revision changesets, per the order computed in 4f1b60dd16 2007-11-22 aku: # pass 6. 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: # Rephrased, the maximal commit position found among the 4f1b60dd16 2007-11-22 aku: # incoming revision changesets is larger than the minimal 4f1b60dd16 2007-11-22 aku: # commit position found among the outgoing revision 4f1b60dd16 2007-11-22 aku: # changesets. Assuming that we have both incoming and outgoing 4f1b60dd16 2007-11-22 aku: # revision changesets. 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: # The helper "Positions" computes the set of commit positions 4f1b60dd16 2007-11-22 aku: # for a set of changesets, which can be a mix of revision and 4f1b60dd16 2007-11-22 aku: # symbol changesets. 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: set predecessors [Positions [$dg nodes -in $cset]] 4f1b60dd16 2007-11-22 aku: set successors [Positions [$dg nodes -out $cset]] 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: return [expr { 4f1b60dd16 2007-11-22 aku: [llength $predecessors] && 4f1b60dd16 2007-11-22 aku: [llength $successors] && 4f1b60dd16 2007-11-22 aku: ([max $predecessors] >= [min $successors]) 4f1b60dd16 2007-11-22 aku: }] 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: proc Positions {changesets} { 4f1b60dd16 2007-11-22 aku: # To compute the set of commit positions from the set of 4f1b60dd16 2007-11-22 aku: # changesets we first map each changeset to its position (*) 4f1b60dd16 2007-11-22 aku: # and then filter out the invalid responses (the empty string) 4f1b60dd16 2007-11-22 aku: # returned by the symbol changesets. 4f1b60dd16 2007-11-22 aku: # 4f1b60dd16 2007-11-22 aku: # (*) This data was loaded into memory earlir in the pass, by 4f1b60dd16 2007-11-22 aku: # LoadCommitOrder. 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: return [struct::list filter [struct::list map $changesets \ 4f1b60dd16 2007-11-22 aku: [myproc ToPosition]] \ 4f1b60dd16 2007-11-22 aku: [myproc ValidPosition]] 4f1b60dd16 2007-11-22 aku: } 4f1b60dd16 2007-11-22 aku: 4f1b60dd16 2007-11-22 aku: proc ToPosition {cset} { $cset pos } 4f1b60dd16 2007-11-22 aku: proc ValidPosition {pos} { expr {$pos ne ""} } 4f1b60dd16 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: proc ComputeLimits {cset lv bv} { e50f9ed55e 2007-11-22 aku: upvar 1 $lv thelimits $bv border e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Initialize the boundaries for all revisions. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: array set limits {} e50f9ed55e 2007-11-22 aku: foreach revision [$cset revisions] { e50f9ed55e 2007-11-22 aku: set limits($revision) {0 {}} e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Compute and store the maximal predecessors per revision e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: foreach {revision csets} [$cset predecessormap] { e50f9ed55e 2007-11-22 aku: set s [Positions $csets] e50f9ed55e 2007-11-22 aku: if {![llength $s]} continue e50f9ed55e 2007-11-22 aku: set limits($revision) [lreplace $limits($revision) 0 0 [max $s]] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Compute and store the minimal successors per revision e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: foreach {revision csets} [$cset successormap] { e50f9ed55e 2007-11-22 aku: set s [Positions $csets] e50f9ed55e 2007-11-22 aku: if {![llength $s]} continue e50f9ed55e 2007-11-22 aku: set limits($revision) [lreplace $limits($revision) 1 1 [min $s]] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Check that the ordering at the file level is correct. We e50f9ed55e 2007-11-22 aku: # cannot have backward ordering per revision, or something is e50f9ed55e 2007-11-22 aku: # wrong. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: foreach revision [array names limits] { e50f9ed55e 2007-11-22 aku: struct::list assign $limits($revision) maxp mins e50f9ed55e 2007-11-22 aku: # Handle min successor position "" as representing infinity e50f9ed55e 2007-11-22 aku: if {$mins eq ""} continue e50f9ed55e 2007-11-22 aku: if {$maxp < $mins} continue e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: trouble internal "Branch revision $revision is backward at file level ($maxp >= $mins)" 4866889e88 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: # Save the limits for the splitter, and compute the border at e50f9ed55e 2007-11-22 aku: # which to split as the minimum of all minimal successor e50f9ed55e 2007-11-22 aku: # positions. e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: set thelimits [array get limits] e50f9ed55e 2007-11-22 aku: set border [min [struct::list filter [struct::list map [Values $thelimits] \ e50f9ed55e 2007-11-22 aku: [myproc MinSuccessorPosition]] \ e50f9ed55e 2007-11-22 aku: [myproc ValidPosition]]] 4866889e88 2007-11-22 aku: return 4866889e88 2007-11-22 aku: } 4866889e88 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: proc Values {dict} { e50f9ed55e 2007-11-22 aku: set res {} e50f9ed55e 2007-11-22 aku: foreach {k v} $dict { lappend res $v } e50f9ed55e 2007-11-22 aku: return $res e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: proc MinSuccessorPosition {item} { lindex $item 1 } e50f9ed55e 2007-11-22 aku: 6d63634309 2007-11-24 aku: proc SplitRevisions {limits border nv bv} { e50f9ed55e 2007-11-22 aku: upvar 1 $nv normalrevisions $bv backwardrevisions e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: set normalrevisions {} e50f9ed55e 2007-11-22 aku: set backwardrevisions {} e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: foreach {rev v} $limits { e50f9ed55e 2007-11-22 aku: struct::list assign $v maxp mins e50f9ed55e 2007-11-22 aku: if {$maxp >= $border} { e50f9ed55e 2007-11-22 aku: lappend backwardrevisions $rev e50f9ed55e 2007-11-22 aku: } else { e50f9ed55e 2007-11-22 aku: lappend normalrevisions $rev e50f9ed55e 2007-11-22 aku: } 4866889e88 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: if {![llength $normalrevisions]} { trouble internal "Set of normal revisions is empty" } e50f9ed55e 2007-11-22 aku: if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" } 4866889e88 2007-11-22 aku: return 1f60018119 2007-11-21 aku: } 4866889e88 2007-11-22 aku: 1f60018119 2007-11-21 aku: 1f60018119 2007-11-21 aku: # # ## ### ##### ######## ############# 1f60018119 2007-11-21 aku: 1ea319fb67 2007-11-25 aku: proc KeepOrder {graph at cset} { 87cf609021 2007-11-24 aku: set cid [$cset id] 87cf609021 2007-11-24 aku: 1ea319fb67 2007-11-25 aku: log write 4 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>" 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # We see here a mixture of symbol and revision changesets. 1ea319fb67 2007-11-25 aku: # The symbol changesets are ignored as irrelevant. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: if {[$cset pos] eq ""} return 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # For the revision changesets we are sure that they are 1ea319fb67 2007-11-25 aku: # consumed in the same order as generated by pass 7 1ea319fb67 2007-11-25 aku: # (RevTopologicalSort). Per the code in cvs2svn. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # NOTE: I cannot see that. Assume cs A and cs B, not dependent 1ea319fb67 2007-11-25 aku: # on each other in the set of revisions, now B after A 1ea319fb67 2007-11-25 aku: # simply means that B has a later time or depends on 1ea319fb67 2007-11-25 aku: # something wit a later time than A. In the full graph A 1ea319fb67 2007-11-25 aku: # may now have dependencies which shift it after B, 1ea319fb67 2007-11-25 aku: # violating the above assumption. 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # Well, it seems to work if I do not make the NTDB root a 1ea319fb67 2007-11-25 aku: # successor of the regular root. Doing so seems to tangle the 1ea319fb67 2007-11-25 aku: # changesets into a knots regarding time vs dependencies and 1ea319fb67 2007-11-25 aku: # trigger such shifts. Keeping these two roots separate OTOH 1ea319fb67 2007-11-25 aku: # disappears the tangle. So, for now I accept that, and for 1ea319fb67 2007-11-25 aku: # paranoia I add code which checks this assumption. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: struct::set exclude myrevisionchangesets $cset 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: ::variable mylastpos 1ea319fb67 2007-11-25 aku: set new [$cset pos] 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: if {$new != ($mylastpos + 1)} { 1ea319fb67 2007-11-25 aku: if {$mylastpos < 0} { 1ea319fb67 2007-11-25 aku: set old "<NONE>" 1ea319fb67 2007-11-25 aku: } else { 1ea319fb67 2007-11-25 aku: ::variable mycset 1ea319fb67 2007-11-25 aku: set old [$mycset($mylastpos) str]@$mylastpos 1ea319fb67 2007-11-25 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old" 87cf609021 2007-11-24 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: set mylastpos $new 87cf609021 2007-11-24 aku: return 87cf609021 2007-11-24 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: proc FormatTR {graph cset} { 1ea319fb67 2007-11-25 aku: return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }] 1f60018119 2007-11-21 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: typevariable mylastpos -1 ; # Position of last revision changeset saved. 1ea319fb67 2007-11-25 aku: typevariable myrevisionchangesets {} ; # Set of revision changesets 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: typevariable myatfmt ; # Format for log output to gain better alignment of the various columns. 1ea319fb67 2007-11-25 aku: typevariable mycsfmt ; # Ditto for the changesets. 1f60018119 2007-11-21 aku: 1f60018119 2007-11-21 aku: # # ## ### ##### ######## ############# 1f60018119 2007-11-21 aku: 1f60018119 2007-11-21 aku: proc BreakCycle {graph} { 1ea319fb67 2007-11-25 aku: # In this pass the cycle breaking can be made a bit more 1ea319fb67 2007-11-25 aku: # targeted, hence this custom callback. 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # First we use the data remembered by 'SaveOrder', about the 1ea319fb67 2007-11-25 aku: # last commit position it handled, to deduce the next revision 1ea319fb67 2007-11-25 aku: # changeset it would encounter. Then we look for the shortest 1ea319fb67 2007-11-25 aku: # predecessor path from it to all other revision changesets 1ea319fb67 2007-11-25 aku: # and break this path. Without such a path we fall back to the 1ea319fb67 2007-11-25 aku: # generic cycle breaker. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: ::variable mylastpos 1ea319fb67 2007-11-25 aku: ::variable mycset 1ea319fb67 2007-11-25 aku: ::variable myrevisionchangesets 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: set nextpos [expr {$mylastpos + 1}] 1ea319fb67 2007-11-25 aku: set next $mycset($nextpos) 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: puts "** Last: $mylastpos = [$mycset($mylastpos) str] @ [$mycset($mylastpos) pos]" 1ea319fb67 2007-11-25 aku: puts "** Next: $nextpos = [$next str] @ [$next pos]" 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: set path [SearchForPath $graph $next $myrevisionchangesets] 1ea319fb67 2007-11-25 aku: if {[llength $path]} { 1ea319fb67 2007-11-25 aku: cyclebreaker break-segment $graph $path 1ea319fb67 2007-11-25 aku: return 1ea319fb67 2007-11-25 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # We were unable to find an ordered changeset in the reachable 1ea319fb67 2007-11-25 aku: # predecessors, fall back to the generic code for breaking the 1ea319fb67 2007-11-25 aku: # found cycle. 1ea319fb67 2007-11-25 aku: 1f60018119 2007-11-21 aku: cyclebreaker break $graph 1f60018119 2007-11-21 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: proc SearchForPath {graph n stopnodes} { 1ea319fb67 2007-11-25 aku: # Search for paths to prerequisites of N. 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # Try to find the shortest dependency path that causes the 1ea319fb67 2007-11-25 aku: # changeset N to depend (directly or indirectly) on one of the 1ea319fb67 2007-11-25 aku: # changesets contained in STOPNODES. 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # We consider direct and indirect dependencies in the sense 1ea319fb67 2007-11-25 aku: # that the changeset can be reached by following a chain of 1ea319fb67 2007-11-25 aku: # predecessor nodes. 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # When one of the csets in STOPNODES is found, we terminate 1ea319fb67 2007-11-25 aku: # the search and return the path from that cset to N. If no 1ea319fb67 2007-11-25 aku: # path is found to a node in STOP_SET, we return the empty 1ea319fb67 2007-11-25 aku: # list/path. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # This is in essence a multi-destination Dijkstra starting at 1ea319fb67 2007-11-25 aku: # N which stops when one of the destinations in STOPNODES has 1ea319fb67 2007-11-25 aku: # been reached, traversing the predecessor arcs. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # REACHABLE :: array (NODE -> list (STEPS, PREVIOUS)) 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # Semantics: NODE can be reached from N in STEPS steps, and 1ea319fb67 2007-11-25 aku: # PREVIOUS is the previous node in the path which reached it, 1ea319fb67 2007-11-25 aku: # allowing us at the end to construct the full path by 1ea319fb67 2007-11-25 aku: # following these backlinks from the found destination. N is 1ea319fb67 2007-11-25 aku: # only included as a key if there is a loop leading back to 1ea319fb67 2007-11-25 aku: # it. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # PENDING :: list (list (NODE, STEPS)) 1ea319fb67 2007-11-25 aku: # 1ea319fb67 2007-11-25 aku: # Semantics: A list of possibilities that still have to be 1ea319fb67 2007-11-25 aku: # investigated, where STEPS is the number of steps to get to 1ea319fb67 2007-11-25 aku: # NODE. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: array set reachable {} 1ea319fb67 2007-11-25 aku: set pending [list [list $n 0]] 1ea319fb67 2007-11-25 aku: set at 0 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: puts "** Searching shortest path ..." 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: while {$at < [llength $pending]} { 1ea319fb67 2007-11-25 aku: struct::list assign [lindex $pending $at] current steps 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: #puts "** [lindex $pending $at] ** [$current str] **" 1ea319fb67 2007-11-25 aku: incr at 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # Process the possibility. This is a breadth-first traversal. 1ea319fb67 2007-11-25 aku: incr steps 1ea319fb67 2007-11-25 aku: foreach pre [$graph nodes -in $current] { 1ea319fb67 2007-11-25 aku: # Since the search is breadth-first, we only have to # 1ea319fb67 2007-11-25 aku: # set nodes that don't already exist. If they do they 1ea319fb67 2007-11-25 aku: # have been reached already on a shorter path. 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: if {[info exists reachable($pre)]} continue 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: set reachable($pre) [list $steps $current] 1ea319fb67 2007-11-25 aku: lappend pending [list $pre $steps] 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # Continue the search while have not reached any of 1ea319fb67 2007-11-25 aku: # our destinations? 1ea319fb67 2007-11-25 aku: if {![struct::set contain $pre $stopnodes]} continue 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # We have arrived, PRE is one of the destination; now 1ea319fb67 2007-11-25 aku: # construct and return the path to it from N by 1ea319fb67 2007-11-25 aku: # following the backlinks in the search state. 1ea319fb67 2007-11-25 aku: set path [list $pre] 1ea319fb67 2007-11-25 aku: while {1} { 1ea319fb67 2007-11-25 aku: set pre [lindex $reachable($pre) 1] 1ea319fb67 2007-11-25 aku: if {$pre eq $n} break 1ea319fb67 2007-11-25 aku: lappend path $pre 1ea319fb67 2007-11-25 aku: } 1ea319fb67 2007-11-25 aku: lappend path $n 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: puts "** Searching shortest path ... Found ([project rev strlist $path])" 1ea319fb67 2007-11-25 aku: return $path 1ea319fb67 2007-11-25 aku: } 1ea319fb67 2007-11-25 aku: } 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: puts "** Searching shortest path ... Not found" 1ea319fb67 2007-11-25 aku: 1ea319fb67 2007-11-25 aku: # No path found. 1ea319fb67 2007-11-25 aku: return {} de4cff4142 2007-11-22 aku: } de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: # # ## ### ##### ######## ############# de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: typevariable mycset -array {} ; # Map from commit positions to the de4cff4142 2007-11-22 aku: # changeset (object ref) at that de4cff4142 2007-11-22 aku: # position. 1f60018119 2007-11-21 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# e7c805f137 2007-11-16 aku: ## Configuration e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: pragma -hasinstances no ; # singleton e7c805f137 2007-11-16 aku: pragma -hastypeinfo no ; # no introspection e7c805f137 2007-11-16 aku: pragma -hastypedestroy no ; # immortal e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: namespace eval ::vc::fossil::import::cvs::pass { e7c805f137 2007-11-16 aku: namespace export breakacycle e7c805f137 2007-11-16 aku: namespace eval breakacycle { e7c805f137 2007-11-16 aku: namespace import ::vc::fossil::import::cvs::cyclebreaker 1f60018119 2007-11-21 aku: namespace import ::vc::fossil::import::cvs::repository e7c805f137 2007-11-16 aku: namespace import ::vc::fossil::import::cvs::state bf83201c7f 2007-11-27 aku: namespace import ::vc::fossil::import::cvs::integrity e7c805f137 2007-11-16 aku: namespace eval project { e7c805f137 2007-11-16 aku: namespace import ::vc::fossil::import::cvs::project::rev e7c805f137 2007-11-16 aku: } 4866889e88 2007-11-22 aku: namespace import ::vc::tools::misc::* 4866889e88 2007-11-22 aku: namespace import ::vc::tools::trouble e7c805f137 2007-11-16 aku: namespace import ::vc::tools::log e7c805f137 2007-11-16 aku: log register breakacycle e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: } e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### e7c805f137 2007-11-16 aku: ## Ready e7c805f137 2007-11-16 aku: e7c805f137 2007-11-16 aku: package provide vc::fossil::import::cvs::pass::breakacycle 1.0 e7c805f137 2007-11-16 aku: return
File Annotation