Artifact 01734176b9489d88add09b3fd41a7de60f230021
File
tools/cvs2fossil/lib/c2f_prevlink.tcl
part of check-in
[38b967dcf5]
- Merge aku's CVS import changes into the main line. Fix a small bug in diff.c.
by
drh on
2007-11-17 00:29:42.
Also file
tools/cvs2fossil/lib/c2f_prevlink.tcl
part of check-in
[94c39d6375]
- Completed pass 6, wrote the code performing the breaking of cycles. Done by analysing each triple of changesets in the cycle at the file dependency level to see which revisions can be sorted apart. Added some additional utility routines. Extended the changeset class with the accessors required by the cycle breaker.
by
aku on
2007-11-14 05:11:56.
## -*- 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 id]> 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 split in the mycategory(prev|next)
# elements. As part of the creation of the new changesets the
# old one is dropped from all databases, in and out of memory,
# and then destroyed.
struct::list assign [$mycset data] project cstype cssrc
$mycset drop
$mycset destroy
set newcsets {}
lappend newcsets [project::rev %AUTO% $project $cstype $cssrc $mycategory(prev)]
lappend newcsets [project::rev %AUTO% $project $cstype $cssrc $mycategory(next)]
foreach c $newcsets { $c persist }
return $newcsets
}
# # ## ### ##### ######## #############
## 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