diff options
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_prevlink.tcl')
| -rw-r--r-- | tools/cvs2fossil/lib/c2f_prevlink.tcl | 240 |
1 files changed, 240 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/c2f_prevlink.tcl b/tools/cvs2fossil/lib/c2f_prevlink.tcl new file mode 100644 index 0000000..53be78c --- /dev/null +++ b/tools/cvs2fossil/lib/c2f_prevlink.tcl @@ -0,0 +1,240 @@ +## -*- 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 +# # ## ### ##### ######## ############# ##################### + +## Helper class for the pass 6 cycle breaker. Each instance refers to +## three changesets A, B, and C, with A a predecessor of B, and B +## predecessor of C, and the whole part of a dependency cycle. + +## Instances analyse the file level dependencies which gave rise to +## the changeset dependencies of A, B, and C, with the results used by +## the cycle breaker algorithm to find a good location where to at +## least weaken and at best fully break the cycle. + +# # ## ### ##### ######## ############# ##################### +## Requirements + +package require Tcl 8.4 ; # Required runtime. +package require snit ; # OO system. +package require vc::tools::misc ; # Text formatting +package require vc::tools::trouble ; # Error reporting. +package require vc::tools::log ; # User feedback. +package require vc::fossil::import::cvs::state ; # State storage. +package require vc::fossil::import::cvs::integrity ; # State integrity checks. +package require vc::fossil::import::cvs::project::rev ; # Project level changesets + +# # ## ### ##### ######## ############# ##################### +## + +snit::type ::vc::fossil::import::cvs::project::revlink { + # # ## ### ##### ######## ############# + ## Public API + + constructor {prev cset next} { + set myprev $prev + set mycset $cset + set mynext $next + + # We perform the bulk of the analysis during construction. The + # file revisions held by the changeset CSET can be sorted into + # four categories. + + # 1. Revisions whose predecessors are not in PREV, nor are + # their successors found in NEXT. These revisions do not + # count, as they did not induce any of the two dependencies + # under consideration. They can be ignored. + + # 2. Revisions which have predecessors in PREV and successors + # in NEXT. They are called 'passthrough' in cvs2svn. They + # induce both dependencies under consideration and are thus + # critical in the creation of the cycle. As such they are + # also unbreakable :( + + # 3. Revisions which have predecessor in PREVE, but no + # successors in NEXT. As such they induced the incoming + # dependency, but not the outgoing one. + + # 4. Revisions which have no predecessors in PREVE, but their + # successors are in NEXT. As such they induced the outgoing + # dependency, but not the incoming one. + + # If we have no passthrough revisions then splitting the + # changeset between categories 3 and 4, with category 1 going + # wherever, will break the cycle. If category 2 revisions are + # present we can still perform the split, this will however + # not break the cycle, only weaken it. + + # NOTE: This is the only remaining user of 'nextmap'. Look + # into the possibility of performing the relevant counting + # within the database. + + array set csetprevmap [Invert [$myprev nextmap]] + array set csetnextmap [$mycset nextmap] + + set prevrev [$myprev items] + set nextrev [$mynext items] + + foreach item [$mycset items] { + set rt [RT $item] + incr mycount($rt) + lappend mycategory($rt) $item + } + return + } + + # Result is TRUE if and only breaking myset will do some good. + method breakable {} { expr {$mycount(prev) || $mycount(next)} } + method passcount {} { return $mycount(pass) } + + method linkstomove {} { + # Return the number of revisions that would be moved should we + # split the changeset. + + set n [min2 $mycount(prev) $mycount(next)] + if {$n > 0 } { return $n } + return [max2 $mycount(prev) $mycount(next)] + } + + method betterthan {other} { + set sbreak [$self breakable] + set obreak [$other breakable] + + if {$sbreak && !$obreak} { return 1 } ; # self is better. + if {!$sbreak && $obreak} { return 0 } ; # self is worse. + + # Equality. Look at the counters. + # - Whichever has the lesser number of passthrough revisions + # is better, as more can be split off, weakening the cycle + # more. + # - Whichever has less links to move is better. + + set opass [$other passcount] + if {$mycount(pass) < $opass} { return 1 } ; # self is better. + if {$mycount(pass) > $opass} { return 0 } ; # self is worse. + + set smove [$self linkstomove] + set omove [$other linkstomove] + + if {$smove < $omove} { return 1 } ; # self is better. + + return 0 ; # Self is worse or equal, i.e. not better. + } + + method break {} { + integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.} + + # One thing to choose when splitting CSET is where the + # revision in categories 1 and 2 (none and passthrough + # respectively) are moved to. This is done using the counters. + + if {!$mycount(prev)} { + # Nothing in category 3 => 1,2 go there, 4 the other. + set mycategory(prev) [concat $mycategory(none) $mycategory(pass)] + } elseif {!$mycount(next)} { + # Nothing in category 4 => 1,2 go there, 3 the other. + set mycategory(next) [concat $mycategory(none) $mycategory(pass)] + } elseif {$mycount(prev) < $mycount(next)} { + # Less predecessors than successors => 1,2 go to the + # sucessors. + set mycategory(next) [concat $mycategory(next) $mycategory(none) \ + $mycategory(pass)] + } else { + # Less successors than predecessors => 1,2 go to the + # predecessors. + set mycategory(next) [concat $mycategory(next) $mycategory(none) \ + $mycategory(pass)] + } + + # We now have the revisions for the two fragments to be in the + # (prev|next) elements of mycategory. + + return [project::rev split $mycset $mycategory(prev) $mycategory(next)] + } + + # # ## ### ##### ######## ############# + ## State + + variable myprev {} ; # Reference to predecessor changeset in the link. + variable mycset {} ; # Reference to the main changeset of the link. + variable mynext {} ; # Reference to the successor changeset in the link. + + # Counters for the revision categories. + variable mycount -array { + none 0 + prev 0 + next 0 + pass 0 + } + # Lists of revisions for the various categories + variable mycategory -array { + none {} + prev {} + next {} + pass {} + } + + # # ## ### ##### ######## ############# + ## Internal methods + + proc RT {r} { + upvar 1 csetprevmap csetprevmap csetnextmap csetnextmap prevrev prevrev nextrev nextrev + + set inc [expr {[info exists csetprevmap($r)] + ? [struct::set size [struct::set intersect $csetprevmap($r) $prevrev]] + : 0}] + set out [expr {[info exists csetnextmap($r)] + ? [struct::set size [struct::set intersect $csetnextmap($r) $nextrev]] + : 0}] + + if {$inc && $out} { return pass } + if {$inc} { return prev } + if {$out} { return next } + return none + } + + proc Invert {dict} { + array set tmp {} + foreach {k values} $dict { + foreach v $values { lappend tmp($v) $k } + } + return [array get tmp] + } + + # # ## ### ##### ######## ############# + ## Configuration + + pragma -hastypeinfo no ; # no type introspection + pragma -hasinfo no ; # no object introspection + pragma -simpledispatch yes ; # simple fast dispatch + + # # ## ### ##### ######## ############# +} + +namespace eval ::vc::fossil::import::cvs::project { + namespace export revlink + namespace eval revlink { + namespace import ::vc::fossil::import::cvs::state + namespace import ::vc::fossil::import::cvs::integrity + namespace import ::vc::tools::misc::* + namespace import ::vc::tools::trouble + namespace eval project { + namespace import ::vc::fossil::import::cvs::project::rev + } + namespace import ::vc::tools::log + log register csets + } +} + +# # ## ### ##### ######## ############# ##################### +## Ready + +package provide vc::fossil::import::cvs::project::revlink 1.0 +return |