Artifact 4abdaecd6fa93c11461385f6b2ec4d9f5b5f212e
File
tools/cvs2fossil/lib/c2f_prevlink.tcl
part of check-in
[87cf609021]
- Created convenience methods to create the human readable repesentation of a changeset and lists of such, and made liberal use of them.
by
aku on
2007-11-24 05:31:30.
## -*- 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::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 sucessors
# 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.
array set csetprevmap [Invert [$myprev nextmap]]
array set csetnextmap [$mycset nextmap]
set prevrev [$myprev revisions]
set nextrev [$mynext revisions]
foreach r [$mycset revisions] {
set rt [RT $r]
incr mycount($rt)
lappend mycategory($rt) $r
}
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 {} {
if {![$self breakable]} {
trouble internal "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::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