94c39d6375 2007-11-14 aku: ## -*- tcl -*- 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# ##################### 94c39d6375 2007-11-14 aku: ## Copyright (c) 2007 Andreas Kupries. 94c39d6375 2007-11-14 aku: # 94c39d6375 2007-11-14 aku: # This software is licensed as described in the file LICENSE, which 94c39d6375 2007-11-14 aku: # you should have received as part of this distribution. 94c39d6375 2007-11-14 aku: # 94c39d6375 2007-11-14 aku: # This software consists of voluntary contributions made by many 94c39d6375 2007-11-14 aku: # individuals. For exact contribution history, see the revision 94c39d6375 2007-11-14 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# ##################### 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: ## Helper class for the pass 6 cycle breaker. Each instance refers to 94c39d6375 2007-11-14 aku: ## three changesets A, B, and C, with A a predecessor of B, and B 94c39d6375 2007-11-14 aku: ## predecessor of C, and the whole part of a dependency cycle. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: ## Instances analyse the file level dependencies which gave rise to 94c39d6375 2007-11-14 aku: ## the changeset dependencies of A, B, and C, with the results used by 94c39d6375 2007-11-14 aku: ## the cycle breaker algorithm to find a good location where to at 94c39d6375 2007-11-14 aku: ## least weaken and at best fully break the cycle. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# ##################### 94c39d6375 2007-11-14 aku: ## Requirements 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: package require Tcl 8.4 ; # Required runtime. 94c39d6375 2007-11-14 aku: package require snit ; # OO system. 94c39d6375 2007-11-14 aku: package require vc::tools::misc ; # Text formatting 94c39d6375 2007-11-14 aku: package require vc::tools::trouble ; # Error reporting. 94c39d6375 2007-11-14 aku: package require vc::tools::log ; # User feedback. 94c39d6375 2007-11-14 aku: package require vc::fossil::import::cvs::state ; # State storage. 47d52d1efd 2007-11-28 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. 94c39d6375 2007-11-14 aku: package require vc::fossil::import::cvs::project::rev ; # Project level changesets 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# ##################### 94c39d6375 2007-11-14 aku: ## 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: snit::type ::vc::fossil::import::cvs::project::revlink { 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# 94c39d6375 2007-11-14 aku: ## Public API 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: constructor {prev cset next} { 94c39d6375 2007-11-14 aku: set myprev $prev 94c39d6375 2007-11-14 aku: set mycset $cset 94c39d6375 2007-11-14 aku: set mynext $next 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # We perform the bulk of the analysis during construction. The 94c39d6375 2007-11-14 aku: # file revisions held by the changeset CSET can be sorted into 94c39d6375 2007-11-14 aku: # four categories. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # 1. Revisions whose predecessors are not in PREV, nor are 94c39d6375 2007-11-14 aku: # their successors found in NEXT. These revisions do not 94c39d6375 2007-11-14 aku: # count, as they did not induce any of the two dependencies 94c39d6375 2007-11-14 aku: # under consideration. They can be ignored. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # 2. Revisions which have predecessors in PREV and sucessors 94c39d6375 2007-11-14 aku: # in NEXT. They are called 'passthrough' in cvs2svn. They 94c39d6375 2007-11-14 aku: # induce both dependencies under consideration and are thus 94c39d6375 2007-11-14 aku: # critical in the creation of the cycle. As such they are 94c39d6375 2007-11-14 aku: # also unbreakable :( 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # 3. Revisions which have predecessor in PREVE, but no 94c39d6375 2007-11-14 aku: # successors in NEXT. As such they induced the incoming 94c39d6375 2007-11-14 aku: # dependency, but not the outgoing one. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # 4. Revisions which have no predecessors in PREVE, but their 94c39d6375 2007-11-14 aku: # successors are in NEXT. As such they induced the outgoing 94c39d6375 2007-11-14 aku: # dependency, but not the incoming one. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # If we have no passthrough revisions then splitting the 94c39d6375 2007-11-14 aku: # changeset between categories 3 and 4, with category 1 going 94c39d6375 2007-11-14 aku: # wherever, will break the cycle. If category 2 revisions are 94c39d6375 2007-11-14 aku: # present we can still perform the split, this will however 94c39d6375 2007-11-14 aku: # not break the cycle, only weaken it. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: array set csetprevmap [Invert [$myprev nextmap]] 94c39d6375 2007-11-14 aku: array set csetnextmap [$mycset nextmap] 94c39d6375 2007-11-14 aku: 61829b076b 2007-11-29 aku: set prevrev [$myprev items] 61829b076b 2007-11-29 aku: set nextrev [$mynext items] 61829b076b 2007-11-29 aku: 4859304926 2007-11-29 aku: foreach item [$mycset items] { 4859304926 2007-11-29 aku: set rt [RT $item] 94c39d6375 2007-11-14 aku: incr mycount($rt) 4859304926 2007-11-29 aku: lappend mycategory($rt) $item 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: return 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # Result is TRUE if and only breaking myset will do some good. 94c39d6375 2007-11-14 aku: method breakable {} { expr {$mycount(prev) || $mycount(next)} } 94c39d6375 2007-11-14 aku: method passcount {} { return $mycount(pass) } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: method linkstomove {} { 94c39d6375 2007-11-14 aku: # Return the number of revisions that would be moved should we 94c39d6375 2007-11-14 aku: # split the changeset. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: set n [min2 $mycount(prev) $mycount(next)] 94c39d6375 2007-11-14 aku: if {$n > 0 } { return $n } 94c39d6375 2007-11-14 aku: return [max2 $mycount(prev) $mycount(next)] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: method betterthan {other} { 94c39d6375 2007-11-14 aku: set sbreak [$self breakable] 94c39d6375 2007-11-14 aku: set obreak [$other breakable] 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: if {$sbreak && !$obreak} { return 1 } ; # self is better. 94c39d6375 2007-11-14 aku: if {!$sbreak && $obreak} { return 0 } ; # self is worse. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # Equality. Look at the counters. 94c39d6375 2007-11-14 aku: # - Whichever has the lesser number of passthrough revisions 94c39d6375 2007-11-14 aku: # is better, as more can be split off, weakening the cycle 94c39d6375 2007-11-14 aku: # more. 94c39d6375 2007-11-14 aku: # - Whichever has less links to move is better. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: set opass [$other passcount] 94c39d6375 2007-11-14 aku: if {$mycount(pass) < $opass} { return 1 } ; # self is better. 94c39d6375 2007-11-14 aku: if {$mycount(pass) > $opass} { return 0 } ; # self is worse. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: set smove [$self linkstomove] 94c39d6375 2007-11-14 aku: set omove [$other linkstomove] 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: if {$smove < $omove} { return 1 } ; # self is better. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: return 0 ; # Self is worse or equal, i.e. not better. 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: method break {} { 47d52d1efd 2007-11-28 aku: integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.} 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # One thing to choose when splitting CSET is where the 94c39d6375 2007-11-14 aku: # revision in categories 1 and 2 (none and passthrough 94c39d6375 2007-11-14 aku: # respectively) are moved to. This is done using the counters. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: if {!$mycount(prev)} { 94c39d6375 2007-11-14 aku: # Nothing in category 3 => 1,2 go there, 4 the other. 94c39d6375 2007-11-14 aku: set mycategory(prev) [concat $mycategory(none) $mycategory(pass)] 94c39d6375 2007-11-14 aku: } elseif {!$mycount(next)} { 94c39d6375 2007-11-14 aku: # Nothing in category 4 => 1,2 go there, 3 the other. 94c39d6375 2007-11-14 aku: set mycategory(next) [concat $mycategory(none) $mycategory(pass)] 94c39d6375 2007-11-14 aku: } elseif {$mycount(prev) < $mycount(next)} { 94c39d6375 2007-11-14 aku: # Less predecessors than successors => 1,2 go to the 94c39d6375 2007-11-14 aku: # sucessors. 94c39d6375 2007-11-14 aku: set mycategory(next) [concat $mycategory(next) $mycategory(none) \ 94c39d6375 2007-11-14 aku: $mycategory(pass)] 94c39d6375 2007-11-14 aku: } else { 94c39d6375 2007-11-14 aku: # Less successors than predecessors => 1,2 go to the 94c39d6375 2007-11-14 aku: # predecessors. 94c39d6375 2007-11-14 aku: set mycategory(next) [concat $mycategory(next) $mycategory(none) \ 94c39d6375 2007-11-14 aku: $mycategory(pass)] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 59207428e2 2007-11-22 aku: # We now have the revisions for the two fragments to be in the 59207428e2 2007-11-22 aku: # (prev|next) elements of mycategory. 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: return [project::rev split $mycset $mycategory(prev) $mycategory(next)] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# 94c39d6375 2007-11-14 aku: ## State 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: variable myprev {} ; # Reference to predecessor changeset in the link. 94c39d6375 2007-11-14 aku: variable mycset {} ; # Reference to the main changeset of the link. 94c39d6375 2007-11-14 aku: variable mynext {} ; # Reference to the successor changeset in the link. 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # Counters for the revision categories. 94c39d6375 2007-11-14 aku: variable mycount -array { 94c39d6375 2007-11-14 aku: none 0 94c39d6375 2007-11-14 aku: prev 0 94c39d6375 2007-11-14 aku: next 0 94c39d6375 2007-11-14 aku: pass 0 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: # Lists of revisions for the various categories 94c39d6375 2007-11-14 aku: variable mycategory -array { 94c39d6375 2007-11-14 aku: none {} 94c39d6375 2007-11-14 aku: prev {} 94c39d6375 2007-11-14 aku: next {} 94c39d6375 2007-11-14 aku: pass {} 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# 94c39d6375 2007-11-14 aku: ## Internal methods 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: proc RT {r} { 94c39d6375 2007-11-14 aku: upvar 1 csetprevmap csetprevmap csetnextmap csetnextmap prevrev prevrev nextrev nextrev 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: set inc [expr {[info exists csetprevmap($r)] 94c39d6375 2007-11-14 aku: ? [struct::set size [struct::set intersect $csetprevmap($r) $prevrev]] 94c39d6375 2007-11-14 aku: : 0}] 94c39d6375 2007-11-14 aku: set out [expr {[info exists csetnextmap($r)] 94c39d6375 2007-11-14 aku: ? [struct::set size [struct::set intersect $csetnextmap($r) $nextrev]] 94c39d6375 2007-11-14 aku: : 0}] 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: if {$inc && $out} { return pass } 94c39d6375 2007-11-14 aku: if {$inc} { return prev } 94c39d6375 2007-11-14 aku: if {$out} { return next } 94c39d6375 2007-11-14 aku: return none 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: proc Invert {dict} { 94c39d6375 2007-11-14 aku: array set tmp {} 94c39d6375 2007-11-14 aku: foreach {k values} $dict { 94c39d6375 2007-11-14 aku: foreach v $values { lappend tmp($v) $k } 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: return [array get tmp] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# 94c39d6375 2007-11-14 aku: ## Configuration 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: pragma -hastypeinfo no ; # no type introspection 94c39d6375 2007-11-14 aku: pragma -hasinfo no ; # no object introspection 94c39d6375 2007-11-14 aku: pragma -simpledispatch yes ; # simple fast dispatch 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: namespace eval ::vc::fossil::import::cvs::project { 94c39d6375 2007-11-14 aku: namespace export revlink 94c39d6375 2007-11-14 aku: namespace eval revlink { 94c39d6375 2007-11-14 aku: namespace import ::vc::fossil::import::cvs::state 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity 94c39d6375 2007-11-14 aku: namespace import ::vc::tools::misc::* 94c39d6375 2007-11-14 aku: namespace import ::vc::tools::trouble 94c39d6375 2007-11-14 aku: namespace eval project { 94c39d6375 2007-11-14 aku: namespace import ::vc::fossil::import::cvs::project::rev 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: namespace import ::vc::tools::log 94c39d6375 2007-11-14 aku: log register csets 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: # # ## ### ##### ######## ############# ##################### 94c39d6375 2007-11-14 aku: ## Ready 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: package provide vc::fossil::import::cvs::project::revlink 1.0 94c39d6375 2007-11-14 aku: return
File Annotation