Fossil SCM

fossil-scm / tools / cvs2fossil / lib / c2f_pbreakacycle.tcl
Source Blame History 433 lines
e7c805f… aku 1 ## -*- tcl -*-
e7c805f… aku 2 # # ## ### ##### ######## ############# #####################
e7c805f… aku 3 ## Copyright (c) 2007 Andreas Kupries.
e7c805f… aku 4 #
e7c805f… aku 5 # This software is licensed as described in the file LICENSE, which
e7c805f… aku 6 # you should have received as part of this distribution.
e7c805f… aku 7 #
e7c805f… aku 8 # This software consists of voluntary contributions made by many
e7c805f… aku 9 # individuals. For exact contribution history, see the revision
e7c805f… aku 10 # history and logs, available at http://fossil-scm.hwaci.com/fossil
e7c805f… aku 11 # # ## ### ##### ######## ############# #####################
e7c805f… aku 12
00bf8c1… aku 13 ## Pass X. This is the final pass for breaking changeset dependency
00bf8c1… aku 14 ## cycles. The previous breaker passes (7 and 9) broke cycles covering
d743f04… aku 15 ## revision and symbol changesets, respectively. This pass now breaks
d743f04… aku 16 ## any remaining cycles, each of which has to contain at least one
d743f04… aku 17 ## revision and at least one symbol changeset.
e7c805f… aku 18
e7c805f… aku 19 # # ## ### ##### ######## ############# #####################
e7c805f… aku 20 ## Requirements
e7c805f… aku 21
e7c805f… aku 22 package require Tcl 8.4 ; # Required runtime.
e7c805f… aku 23 package require snit ; # OO system.
e7c805f… aku 24 package require struct::list ; # Higher order list operations.
1ea319f… aku 25 package require struct::set ; # Set operations.
4866889… aku 26 package require vc::tools::misc ; # Min, max.
e7c805f… aku 27 package require vc::tools::log ; # User feedback.
4866889… aku 28 package require vc::tools::trouble ; # Error reporting.
1f60018… aku 29 package require vc::fossil::import::cvs::repository ; # Repository management.
e7c805f… aku 30 package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles.
e7c805f… aku 31 package require vc::fossil::import::cvs::state ; # State storage.
bf83201… aku 32 package require vc::fossil::import::cvs::integrity ; # State integrity checks.
e7c805f… aku 33 package require vc::fossil::import::cvs::project::rev ; # Project level changesets
e7c805f… aku 34
e7c805f… aku 35 # # ## ### ##### ######## ############# #####################
e7c805f… aku 36 ## Register the pass with the management
e7c805f… aku 37
e7c805f… aku 38 vc::fossil::import::cvs::pass define \
e7c805f… aku 39 BreakAllCsetCycles \
e7c805f… aku 40 {Break Remaining ChangeSet Dependency Cycles} \
e7c805f… aku 41 ::vc::fossil::import::cvs::pass::breakacycle
e7c805f… aku 42
e7c805f… aku 43 # # ## ### ##### ######## ############# #####################
b679ca3… aku 44 ##
e7c805f… aku 45
e7c805f… aku 46 snit::type ::vc::fossil::import::cvs::pass::breakacycle {
e7c805f… aku 47 # # ## ### ##### ######## #############
e7c805f… aku 48 ## Public API
e7c805f… aku 49
e7c805f… aku 50 typemethod setup {} {
e7c805f… aku 51 # Define the names and structure of the persistent state of
e7c805f… aku 52 # this pass.
de4cff4… aku 53
e288af3… aku 54 state use revision
e288af3… aku 55 state use tag
e288af3… aku 56 state use branch
e288af3… aku 57 state use symbol
e288af3… aku 58 state use changeset
e288af3… aku 59 state use csitem
e288af3… aku 60 state use cssuccessor
e7c805f… aku 61 return
e7c805f… aku 62 }
e7c805f… aku 63
e7c805f… aku 64 typemethod load {} {
e7c805f… aku 65 # Pass manager interface. Executed to load data computed by
e7c805f… aku 66 # this pass into memory when this pass is skipped instead of
e7c805f… aku 67 # executed.
e7c805f… aku 68 return
e7c805f… aku 69 }
e7c805f… aku 70
e7c805f… aku 71 typemethod run {} {
e7c805f… aku 72 # Pass manager interface. Executed to perform the
e7c805f… aku 73 # functionality of the pass.
7f15be9… aku 74
1ea319f… aku 75 set len [string length [project::rev num]]
1ea319f… aku 76 set myatfmt %${len}s
6b520e7… aku 77 incr len 12
1ea319f… aku 78 set mycsfmt %${len}s
1ea319f… aku 79
6b520e7… aku 80 cyclebreaker precmd [myproc BreakBackward]
1ea319f… aku 81 cyclebreaker savecmd [myproc KeepOrder]
1f60018… aku 82
1f60018… aku 83 state transaction {
de4cff4… aku 84 LoadCommitOrder
1f60018… aku 85 cyclebreaker run break-all [myproc Changesets]
1f60018… aku 86 }
8c6488d… aku 87
8c6488d… aku 88 repository printcsetstatistics
00bf8c1… aku 89 integrity changesets
e7c805f… aku 90 return
e7c805f… aku 91 }
e7c805f… aku 92
e7c805f… aku 93 typemethod discard {} {
e7c805f… aku 94 # Pass manager interface. Executed for all passes after the
e7c805f… aku 95 # run passes, to remove all data of this pass from the state,
e7c805f… aku 96 # as being out of date.
e7c805f… aku 97 return
e7c805f… aku 98 }
e7c805f… aku 99
e7c805f… aku 100 # # ## ### ##### ######## #############
e7c805f… aku 101 ## Internal methods
2a0ec50… aku 102
00bf8c1… aku 103 proc Changesets {} {
00bf8c1… aku 104 log write 2 breakrcycle {Selecting all changesets}
00bf8c1… aku 105 return [project::rev all]
00bf8c1… aku 106 }
4f1b60d… aku 107
4f1b60d… aku 108 proc LoadCommitOrder {} {
4f1b60d… aku 109 ::variable mycset
1ea319f… aku 110 ::variable myrevisionchangesets
1ea319f… aku 111
711e000… aku 112 log write 2 breakacycle {Loading revision commit order}
711e000… aku 113
711e000… aku 114 set n 0
4f1b60d… aku 115 state transaction {
f637d42… aku 116 state foreachrow {
f637d42… aku 117 SELECT cid, pos FROM csorder
f637d42… aku 118 } {
2290507… aku 119 log progress 2 breakacycle $n {}
4f1b60d… aku 120 set cset [project::rev of $cid]
4f1b60d… aku 121 $cset setpos $pos
4f1b60d… aku 122 set mycset($pos) $cset
1ea319f… aku 123 lappend myrevisionchangesets $cset
711e000… aku 124 incr n
4f1b60d… aku 125 }
4f1b60d… aku 126 }
4f1b60d… aku 127 return
4f1b60d… aku 128 }
4f1b60d… aku 129
4f1b60d… aku 130 # # ## ### ##### ######## #############
4f1b60d… aku 131
6b520e7… aku 132 proc BreakBackward {graph} {
4f1b60d… aku 133 # We go over all branch changesets, i.e. the changesets
4f1b60d… aku 134 # created by the symbols which are translated as branches, and
4f1b60d… aku 135 # break any which are 'backward', which means that they have
4f1b60d… aku 136 # at least one incoming revision changeset which is committed
4f1b60d… aku 137 # after at least one of the outgoing revision changesets, per
4f1b60d… aku 138 # the order computed in pass 6. In "cvs2svn" this is called
4f1b60d… aku 139 # "retrograde".
4f1b60d… aku 140
a437da4… aku 141 set n 0
a437da4… aku 142 set max [llength [$graph nodes]]
e50f9ed… aku 143 foreach cset [$graph nodes] {
a437da4… aku 144 log progress 2 breakacycle $n $max ; incr n
af5904e… aku 145 if {![$cset isbranch]} continue
6b520e7… aku 146 CheckAndBreakBackward $graph $cset
e50f9ed… aku 147 }
e50f9ed… aku 148 return
e50f9ed… aku 149 }
e50f9ed… aku 150
6b520e7… aku 151 proc CheckAndBreakBackward {graph cset} {
6b520e7… aku 152 while {[IsBackward $graph $cset]} {
af5904e… aku 153 # Knowing that the branch changeset is backward we now
af5904e… aku 154 # look at the individual branches in the changeset and
af5904e… aku 155 # determine which of them are responsible for the
af5904e… aku 156 # overlap. This allows us to split them into two sets, one
af5904e… aku 157 # of non-overlapping branches, and of overlapping
af5904e… aku 158 # ones. Each set induces a new changeset, and the second
af5904e… aku 159 # one may still be backward and in need of further
af5904e… aku 160 # splitting. Hence the looping.
711e000… aku 161
e50f9ed… aku 162 # The border used for the split is the minimal commit
e50f9ed… aku 163 # position among the minimal sucessor commit positions for
711e000… aku 164 # the branches in the changeset. We sort the file level
711e000… aku 165 # items based on there they sit relative to the border
711e000… aku 166 # into before and after the border. As the branches cannot
711e000… aku 167 # be backward at file level thos before the border cannot
711e000… aku 168 # generate a backward symbol changeset, however the
711e000… aku 169 # branches after may constitute another backward branch
711e000… aku 170 # with a new border.
e50f9ed… aku 171
e50f9ed… aku 172 # limits : dict (revision -> list (max predecessor commit, min sucessor commit))
e50f9ed… aku 173
e50f9ed… aku 174 ComputeLimits $cset limits border
e50f9ed… aku 175
711e000… aku 176 log write 5 breakacycle "Breaking backward changeset [$cset str] using commit position $border as border"
af5904e… aku 177
af5904e… aku 178 SplitItems $limits $border normalitems backwarditems
af5904e… aku 179
af5904e… aku 180 set replacements [project::rev split $cset $normalitems $backwarditems]
e50f9ed… aku 181 cyclebreaker replace $graph $cset $replacements
e50f9ed… aku 182
711e000… aku 183 # At last we check that the normal frament is indeed not
e50f9ed… aku 184 # backward, and iterate over the possibly still backward
e50f9ed… aku 185 # second fragment.
e50f9ed… aku 186
e50f9ed… aku 187 struct::list assign $replacements normal backward
47d52d1… aku 188 integrity assert {
47d52d1… aku 189 ![IsBackward $graph $normal]
47d52d1… aku 190 } {The normal fragment is unexpectedly backward}
e50f9ed… aku 191
e50f9ed… aku 192 set cset $backward
e50f9ed… aku 193 }
e50f9ed… aku 194 return
e50f9ed… aku 195 }
e50f9ed… aku 196
6b520e7… aku 197 proc IsBackward {dg cset} {
e50f9ed… aku 198 # A branch is "backward" if it has at least one incoming
e50f9ed… aku 199 # revision changeset which is committed after at least one of
af5904e… aku 200 # the outgoing revision changesets, per the order computed by
4f1b60d… aku 201 # pass 6.
4f1b60d… aku 202
4f1b60d… aku 203 # Rephrased, the maximal commit position found among the
4f1b60d… aku 204 # incoming revision changesets is larger than the minimal
4f1b60d… aku 205 # commit position found among the outgoing revision
4f1b60d… aku 206 # changesets. Assuming that we have both incoming and outgoing
af5904e… aku 207 # revision changesets for the branch.
4f1b60d… aku 208
4f1b60d… aku 209 # The helper "Positions" computes the set of commit positions
4f1b60d… aku 210 # for a set of changesets, which can be a mix of revision and
4f1b60d… aku 211 # symbol changesets.
4f1b60d… aku 212
4f1b60d… aku 213 set predecessors [Positions [$dg nodes -in $cset]]
4f1b60d… aku 214 set successors [Positions [$dg nodes -out $cset]]
4f1b60d… aku 215
4f1b60d… aku 216 return [expr {
4f1b60d… aku 217 [llength $predecessors] &&
4f1b60d… aku 218 [llength $successors] &&
4f1b60d… aku 219 ([max $predecessors] >= [min $successors])
4f1b60d… aku 220 }]
4f1b60d… aku 221 }
4f1b60d… aku 222
4f1b60d… aku 223 proc Positions {changesets} {
4f1b60d… aku 224 # To compute the set of commit positions from the set of
4f1b60d… aku 225 # changesets we first map each changeset to its position (*)
4f1b60d… aku 226 # and then filter out the invalid responses (the empty string)
4f1b60d… aku 227 # returned by the symbol changesets.
4f1b60d… aku 228 #
4f1b60d… aku 229 # (*) This data was loaded into memory earlir in the pass, by
4f1b60d… aku 230 # LoadCommitOrder.
4f1b60d… aku 231
4f1b60d… aku 232 return [struct::list filter [struct::list map $changesets \
4f1b60d… aku 233 [myproc ToPosition]] \
4f1b60d… aku 234 [myproc ValidPosition]]
4f1b60d… aku 235 }
4f1b60d… aku 236
4f1b60d… aku 237 proc ToPosition {cset} { $cset pos }
4f1b60d… aku 238 proc ValidPosition {pos} { expr {$pos ne ""} }
4f1b60d… aku 239
e50f9ed… aku 240 proc ComputeLimits {cset lv bv} {
e50f9ed… aku 241 upvar 1 $lv thelimits $bv border
e50f9ed… aku 242
711e000… aku 243 # Individual branches may not have revision changesets which
711e000… aku 244 # are their predecessors and/or successors, leaving the limits
711e000… aku 245 # partially or completely undefined. To overcome this
711e000… aku 246 # initialize boundaries for all items with proper defaults (-1
711e000… aku 247 # for max, {} for min, representing +infinity).
711e000… aku 248
711e000… aku 249 array set maxpa {}
711e000… aku 250 array set minsa {}
711e000… aku 251 foreach item [$cset items] {
711e000… aku 252 set maxpa($item) -1
711e000… aku 253 set minsa($item) {}
711e000… aku 254 }
711e000… aku 255
711e000… aku 256 # Get the limits from the database, for the items which
711e000… aku 257 # actually have such, and merge the information with the
711e000… aku 258 # defaults.
711e000… aku 259
711e000… aku 260 struct::list assign [$cset limits] maxpdict minsdict
711e000… aku 261
711e000… aku 262 array set maxpa $maxpdict
711e000… aku 263 array set minsa $minsdict
af5904e… aku 264
af5904e… aku 265 # Check that the ordering at the file level is correct. We
af5904e… aku 266 # cannot have backward ordering per branch, or something is
af5904e… aku 267 # wrong.
af5904e… aku 268
af5904e… aku 269 foreach item [array names limits] {
711e000… aku 270 set mins $minsa($item)
711e000… aku 271 set maxp $maxp($item)
711e000… aku 272 # Note that for the min successor position "" represents
711e000… aku 273 # +infinity
af5904e… aku 274 integrity assert {
e757cd3… jan.nijtmans 275 ($mins eq "") || ($maxp < $mins)
af5904e… aku 276 } {Item <$item> is backward at file level ($maxp >= $mins)}
e50f9ed… aku 277 }
e50f9ed… aku 278
e50f9ed… aku 279 # Save the limits for the splitter, and compute the border at
e50f9ed… aku 280 # which to split as the minimum of all minimal successor
e50f9ed… aku 281 # positions.
e50f9ed… aku 282
711e000… aku 283 # Compute the border at which to split as the minimum of all
711e000… aku 284 # minimal successor positions. By using the database info we
711e000… aku 285 # automatically/implicitly filter out anything without a min
711e000… aku 286 # successor. Further the data going into the comparison with
711e000… aku 287 # the border is put together.
711e000… aku 288
711e000… aku 289 set border [min [Values $minsdict]]
711e000… aku 290 set thelimits [array get maxpa]
e50f9ed… aku 291 return
e50f9ed… aku 292 }
e50f9ed… aku 293
e50f9ed… aku 294 proc Values {dict} {
e50f9ed… aku 295 set res {}
e50f9ed… aku 296 foreach {k v} $dict { lappend res $v }
e50f9ed… aku 297 return $res
e50f9ed… aku 298 }
e50f9ed… aku 299
af5904e… aku 300 proc SplitItems {limits border nv bv} {
af5904e… aku 301 upvar 1 $nv normalitems $bv backwarditems
af5904e… aku 302
af5904e… aku 303 set normalitems {}
af5904e… aku 304 set backwarditems {}
af5904e… aku 305
711e000… aku 306 foreach {item maxp} $limits {
af5904e… aku 307 if {$maxp >= $border} {
711e000… aku 308 lappend backwarditems $item
af5904e… aku 309 } else {
711e000… aku 310 lappend normalitems $item
af5904e… aku 311 }
af5904e… aku 312 }
af5904e… aku 313
af5904e… aku 314 integrity assert {[llength $normalitems]} {Set of normal items is empty}
af5904e… aku 315 integrity assert {[llength $backwarditems]} {Set of backward items is empty}
af5904e… aku 316 return
af5904e… aku 317 }
d743f04… aku 318
d743f04… aku 319 # # ## ### ##### ######## #############
d743f04… aku 320
1ea319f… aku 321 proc KeepOrder {graph at cset} {
6b520e7… aku 322 ::variable myatfmt
6b520e7… aku 323 ::variable mycsfmt
6b520e7… aku 324
1ea319f… aku 325 set cid [$cset id]
1ea319f… aku 326
6b520e7… aku 327 log write 8 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>"
1ea319f… aku 328
1ea319f… aku 329 # We see here a mixture of symbol and revision changesets.
1ea319f… aku 330 # The symbol changesets are ignored as irrelevant.
1ea319f… aku 331
1ea319f… aku 332 if {[$cset pos] eq ""} return
1ea319f… aku 333
1ea319f… aku 334 # For the revision changesets we are sure that they are
1ea319f… aku 335 # consumed in the same order as generated by pass 7
1ea319f… aku 336 # (RevTopologicalSort). Per the code in cvs2svn.
1ea319f… aku 337
af5904e… aku 338 # This works if and only if none of the symbol changesets are
af5904e… aku 339 # "backwards", hence our breaking of the backward changesets
af5904e… aku 340 # first, in the pre-hook.
af5904e… aku 341
83ecb5b… aku 342 # Note that tag changesets cannot be backward as they don't
af5904e… aku 343 # have successors at all.
af5904e… aku 344
af5904e… aku 345 # An interesting thing IMHO, is that after breaking the
af5904e… aku 346 # backward symbol changesets we should not have any circles
af5904e… aku 347 # any longer. Each circle which would still be present has to
af5904e… aku 348 # involve a backward symbol, and we split them all, so there
af5904e… aku 349 # can't be a circle..
af5904e… aku 350
af5904e… aku 351 # Proof:
af5904e… aku 352 # Let us assume we that have a circle
6b520e7… aku 353 # C: R1 -> ... -> Rx -> S -> Ry -> ... -> Rn -> R1
af5904e… aku 354 # Let us further assume that the symbol changeset S in that
af5904e… aku 355 # circle is not backward. That means ORD(Rx) < ORD(Ry). The
af5904e… aku 356 # earlier topological sorting without symbols now forces this
af5904e… aku 357 # relationship through to be ORD(Rx) < ORD(R1) < ORD(Rx). We
af5904e… aku 358 # have reached an impossibility, a paradox. Our initial
6b520e7… aku 359 # assumption of S not being backward cannot hold.
6b520e7… aku 360 #
6b520e7… aku 361 # Alternate, direct, reasoning: Without S the chain of
6b520e7… aku 362 # dependencies is Ry -> .. -> R1 -> .. -> Rx, therefore
6b520e7… aku 363 # ORD(Ry) < ORD(Rx) holds, and this means S is backward.
1ea319f… aku 364
1ea319f… aku 365 struct::set exclude myrevisionchangesets $cset
1ea319f… aku 366
1ea319f… aku 367 ::variable mylastpos
1ea319f… aku 368 set new [$cset pos]
1ea319f… aku 369
1ea319f… aku 370 if {$new != ($mylastpos + 1)} {
1ea319f… aku 371 if {$mylastpos < 0} {
1ea319f… aku 372 set old "<NONE>"
1ea319f… aku 373 } else {
1ea319f… aku 374 ::variable mycset
1ea319f… aku 375 set old [$mycset($mylastpos) str]@$mylastpos
1ea319f… aku 376 }
1ea319f… aku 377
2290507… aku 378 #integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
2290507… aku 379 log write 2 breakacycle {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
1ea319f… aku 380 }
1ea319f… aku 381
1ea319f… aku 382 set mylastpos $new
1ea319f… aku 383 return
1ea319f… aku 384 }
1ea319f… aku 385
1ea319f… aku 386 proc FormatTR {graph cset} {
1ea319f… aku 387 return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }]
d743f04… aku 388 }
1ea319f… aku 389
1ea319f… aku 390 typevariable mylastpos -1 ; # Position of last revision changeset saved.
1ea319f… aku 391 typevariable myrevisionchangesets {} ; # Set of revision changesets
1ea319f… aku 392
1ea319f… aku 393 typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
1ea319f… aku 394 typevariable mycsfmt ; # Ditto for the changesets.
1f60018… aku 395
1f60018… aku 396 # # ## ### ##### ######## #############
1f60018… aku 397
de4cff4… aku 398 typevariable mycset -array {} ; # Map from commit positions to the
de4cff4… aku 399 # changeset (object ref) at that
de4cff4… aku 400 # position.
e7c805f… aku 401
e7c805f… aku 402 # # ## ### ##### ######## #############
e7c805f… aku 403 ## Configuration
e7c805f… aku 404
e7c805f… aku 405 pragma -hasinstances no ; # singleton
e7c805f… aku 406 pragma -hastypeinfo no ; # no introspection
e7c805f… aku 407 pragma -hastypedestroy no ; # immortal
e7c805f… aku 408
e7c805f… aku 409 # # ## ### ##### ######## #############
e7c805f… aku 410 }
e7c805f… aku 411
e7c805f… aku 412 namespace eval ::vc::fossil::import::cvs::pass {
e7c805f… aku 413 namespace export breakacycle
e7c805f… aku 414 namespace eval breakacycle {
e7c805f… aku 415 namespace import ::vc::fossil::import::cvs::cyclebreaker
1f60018… aku 416 namespace import ::vc::fossil::import::cvs::repository
e7c805f… aku 417 namespace import ::vc::fossil::import::cvs::state
bf83201… aku 418 namespace import ::vc::fossil::import::cvs::integrity
e7c805f… aku 419 namespace eval project {
e7c805f… aku 420 namespace import ::vc::fossil::import::cvs::project::rev
e7c805f… aku 421 }
4866889… aku 422 namespace import ::vc::tools::misc::*
4866889… aku 423 namespace import ::vc::tools::trouble
e7c805f… aku 424 namespace import ::vc::tools::log
e7c805f… aku 425 log register breakacycle
e7c805f… aku 426 }
e7c805f… aku 427 }
e7c805f… aku 428
e7c805f… aku 429 # # ## ### ##### ######## ############# #####################
e7c805f… aku 430 ## Ready
e7c805f… aku 431
e7c805f… aku 432 package provide vc::fossil::import::cvs::pass::breakacycle 1.0
e7c805f… aku 433 return

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button