Artifact 6d6903cdcab3809b6f7cf19e1073e754bed592d2
File
tools/cvs2fossil/lib/c2f_pbreakacycle.tcl
part of check-in
[83ecb5b945]
- Fix comment typo, and add comment about possible simplification.
by
aku on
2008-02-27 08:00:54.
## -*- 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
# # ## ### ##### ######## ############# #####################
## Pass X. This is the final pass for breaking changeset dependency
## cycles. The previous breaker passes (7 and 9) broke cycles covering
## revision and symbol changesets, respectively. This pass now breaks
## any remaining cycles, each of which has to contain at least one
## revision and at least one symbol changeset.
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require struct::list ; # Higher order list operations.
package require struct::set ; # Set operations.
package require vc::tools::misc ; # Min, max.
package require vc::tools::log ; # User feedback.
package require vc::tools::trouble ; # Error reporting.
package require vc::fossil::import::cvs::repository ; # Repository management.
package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles.
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
# # ## ### ##### ######## ############# #####################
## Register the pass with the management
vc::fossil::import::cvs::pass define \
BreakAllCsetCycles \
{Break Remaining ChangeSet Dependency Cycles} \
::vc::fossil::import::cvs::pass::breakacycle
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::pass::breakacycle {
# # ## ### ##### ######## #############
## Public API
typemethod setup {} {
# Define the names and structure of the persistent state of
# this pass.
state use revision
state use tag
state use branch
state use symbol
state use changeset
state use csitem
state use cssuccessor
return
}
typemethod load {} {
# Pass manager interface. Executed to load data computed by
# this pass into memory when this pass is skipped instead of
# executed.
return
}
typemethod run {} {
# Pass manager interface. Executed to perform the
# functionality of the pass.
set len [string length [project::rev num]]
set myatfmt %${len}s
incr len 12
set mycsfmt %${len}s
cyclebreaker precmd [myproc BreakBackward]
cyclebreaker savecmd [myproc KeepOrder]
state transaction {
LoadCommitOrder
cyclebreaker run break-all [myproc Changesets]
}
repository printcsetstatistics
integrity changesets
return
}
typemethod discard {} {
# Pass manager interface. Executed for all passes after the
# run passes, to remove all data of this pass from the state,
# as being out of date.
return
}
# # ## ### ##### ######## #############
## Internal methods
proc Changesets {} {
log write 2 breakrcycle {Selecting all changesets}
return [project::rev all]
}
proc LoadCommitOrder {} {
::variable mycset
::variable myrevisionchangesets
log write 2 breakacycle {Loading revision commit order}
set n 0
state transaction {
state foreachrow {
SELECT cid, pos FROM csorder
} {
log progress 2 breakacycle $n {}
set cset [project::rev of $cid]
$cset setpos $pos
set mycset($pos) $cset
lappend myrevisionchangesets $cset
incr n
}
}
return
}
# # ## ### ##### ######## #############
proc BreakBackward {graph} {
# We go over all branch changesets, i.e. the changesets
# created by the symbols which are translated as branches, and
# break any which are 'backward', which means that they have
# at least one incoming revision changeset which is committed
# after at least one of the outgoing revision changesets, per
# the order computed in pass 6. In "cvs2svn" this is called
# "retrograde".
set n 0
set max [llength [$graph nodes]]
foreach cset [$graph nodes] {
log progress 2 breakacycle $n $max ; incr n
if {![$cset isbranch]} continue
CheckAndBreakBackward $graph $cset
}
return
}
proc CheckAndBreakBackward {graph cset} {
while {[IsBackward $graph $cset]} {
# Knowing that the branch changeset is backward we now
# look at the individual branches in the changeset and
# determine which of them are responsible for the
# overlap. This allows us to split them into two sets, one
# of non-overlapping branches, and of overlapping
# ones. Each set induces a new changeset, and the second
# one may still be backward and in need of further
# splitting. Hence the looping.
# The border used for the split is the minimal commit
# position among the minimal sucessor commit positions for
# the branches in the changeset. We sort the file level
# items based on there they sit relative to the border
# into before and after the border. As the branches cannot
# be backward at file level thos before the border cannot
# generate a backward symbol changeset, however the
# branches after may constitute another backward branch
# with a new border.
# limits : dict (revision -> list (max predecessor commit, min sucessor commit))
ComputeLimits $cset limits border
log write 5 breakacycle "Breaking backward changeset [$cset str] using commit position $border as border"
SplitItems $limits $border normalitems backwarditems
set replacements [project::rev split $cset $normalitems $backwarditems]
cyclebreaker replace $graph $cset $replacements
# At last we check that the normal frament is indeed not
# backward, and iterate over the possibly still backward
# second fragment.
struct::list assign $replacements normal backward
integrity assert {
![IsBackward $graph $normal]
} {The normal fragment is unexpectedly backward}
set cset $backward
}
return
}
proc IsBackward {dg cset} {
# A branch is "backward" if it has at least one incoming
# revision changeset which is committed after at least one of
# the outgoing revision changesets, per the order computed by
# pass 6.
# Rephrased, the maximal commit position found among the
# incoming revision changesets is larger than the minimal
# commit position found among the outgoing revision
# changesets. Assuming that we have both incoming and outgoing
# revision changesets for the branch.
# The helper "Positions" computes the set of commit positions
# for a set of changesets, which can be a mix of revision and
# symbol changesets.
set predecessors [Positions [$dg nodes -in $cset]]
set successors [Positions [$dg nodes -out $cset]]
return [expr {
[llength $predecessors] &&
[llength $successors] &&
([max $predecessors] >= [min $successors])
}]
}
proc Positions {changesets} {
# To compute the set of commit positions from the set of
# changesets we first map each changeset to its position (*)
# and then filter out the invalid responses (the empty string)
# returned by the symbol changesets.
#
# (*) This data was loaded into memory earlir in the pass, by
# LoadCommitOrder.
return [struct::list filter [struct::list map $changesets \
[myproc ToPosition]] \
[myproc ValidPosition]]
}
proc ToPosition {cset} { $cset pos }
proc ValidPosition {pos} { expr {$pos ne ""} }
proc ComputeLimits {cset lv bv} {
upvar 1 $lv thelimits $bv border
# Individual branches may not have revision changesets which
# are their predecessors and/or successors, leaving the limits
# partially or completely undefined. To overcome this
# initialize boundaries for all items with proper defaults (-1
# for max, {} for min, representing +infinity).
array set maxpa {}
array set minsa {}
foreach item [$cset items] {
set maxpa($item) -1
set minsa($item) {}
}
# Get the limits from the database, for the items which
# actually have such, and merge the information with the
# defaults.
struct::list assign [$cset limits] maxpdict minsdict
array set maxpa $maxpdict
array set minsa $minsdict
# Check that the ordering at the file level is correct. We
# cannot have backward ordering per branch, or something is
# wrong.
foreach item [array names limits] {
set mins $minsa($item)
set maxp $maxp($item)
# Note that for the min successor position "" represents
# +infinity
integrity assert {
($mins eq "") || ($maxp < $mins)
} {Item <$item> is backward at file level ($maxp >= $mins)}
}
# Save the limits for the splitter, and compute the border at
# which to split as the minimum of all minimal successor
# positions.
# Compute the border at which to split as the minimum of all
# minimal successor positions. By using the database info we
# automatically/implicitly filter out anything without a min
# successor. Further the data going into the comparison with
# the border is put together.
set border [min [Values $minsdict]]
set thelimits [array get maxpa]
return
}
proc Values {dict} {
set res {}
foreach {k v} $dict { lappend res $v }
return $res
}
proc SplitItems {limits border nv bv} {
upvar 1 $nv normalitems $bv backwarditems
set normalitems {}
set backwarditems {}
foreach {item maxp} $limits {
if {$maxp >= $border} {
lappend backwarditems $item
} else {
lappend normalitems $item
}
}
integrity assert {[llength $normalitems]} {Set of normal items is empty}
integrity assert {[llength $backwarditems]} {Set of backward items is empty}
return
}
# # ## ### ##### ######## #############
proc KeepOrder {graph at cset} {
::variable myatfmt
::variable mycsfmt
set cid [$cset id]
log write 8 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>"
# We see here a mixture of symbol and revision changesets.
# The symbol changesets are ignored as irrelevant.
if {[$cset pos] eq ""} return
# For the revision changesets we are sure that they are
# consumed in the same order as generated by pass 7
# (RevTopologicalSort). Per the code in cvs2svn.
# This works if and only if none of the symbol changesets are
# "backwards", hence our breaking of the backward changesets
# first, in the pre-hook.
# Note that tag changesets cannot be backward as they don't
# have successors at all.
# An interesting thing IMHO, is that after breaking the
# backward symbol changesets we should not have any circles
# any longer. Each circle which would still be present has to
# involve a backward symbol, and we split them all, so there
# can't be a circle..
# Proof:
# Let us assume we that have a circle
# C: R1 -> ... -> Rx -> S -> Ry -> ... -> Rn -> R1
# Let us further assume that the symbol changeset S in that
# circle is not backward. That means ORD(Rx) < ORD(Ry). The
# earlier topological sorting without symbols now forces this
# relationship through to be ORD(Rx) < ORD(R1) < ORD(Rx). We
# have reached an impossibility, a paradox. Our initial
# assumption of S not being backward cannot hold.
#
# Alternate, direct, reasoning: Without S the chain of
# dependencies is Ry -> .. -> R1 -> .. -> Rx, therefore
# ORD(Ry) < ORD(Rx) holds, and this means S is backward.
struct::set exclude myrevisionchangesets $cset
::variable mylastpos
set new [$cset pos]
if {$new != ($mylastpos + 1)} {
if {$mylastpos < 0} {
set old "<NONE>"
} else {
::variable mycset
set old [$mycset($mylastpos) str]@$mylastpos
}
#integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
log write 2 breakacycle {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
}
set mylastpos $new
return
}
proc FormatTR {graph cset} {
return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }]
}
typevariable mylastpos -1 ; # Position of last revision changeset saved.
typevariable myrevisionchangesets {} ; # Set of revision changesets
typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
typevariable mycsfmt ; # Ditto for the changesets.
# # ## ### ##### ######## #############
typevariable mycset -array {} ; # Map from commit positions to the
# changeset (object ref) at that
# position.
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
}
namespace eval ::vc::fossil::import::cvs::pass {
namespace export breakacycle
namespace eval breakacycle {
namespace import ::vc::fossil::import::cvs::cyclebreaker
namespace import ::vc::fossil::import::cvs::repository
namespace import ::vc::fossil::import::cvs::state
namespace import ::vc::fossil::import::cvs::integrity
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::rev
}
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::trouble
namespace import ::vc::tools::log
log register breakacycle
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::pass::breakacycle 1.0
return