| | @@ -20,10 +20,11 @@ |
| 20 | 20 | ## Requirements |
| 21 | 21 | |
| 22 | 22 | package require Tcl 8.4 ; # Required runtime. |
| 23 | 23 | package require snit ; # OO system. |
| 24 | 24 | package require struct::list ; # Higher order list operations. |
| 25 | +package require struct::set ; # Set operations. |
| 25 | 26 | package require vc::tools::misc ; # Min, max. |
| 26 | 27 | package require vc::tools::log ; # User feedback. |
| 27 | 28 | package require vc::tools::trouble ; # Error reporting. |
| 28 | 29 | package require vc::fossil::import::cvs::repository ; # Repository management. |
| 29 | 30 | package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles. |
| | @@ -61,12 +62,18 @@ |
| 61 | 62 | } |
| 62 | 63 | |
| 63 | 64 | typemethod run {} { |
| 64 | 65 | # Pass manager interface. Executed to perform the |
| 65 | 66 | # functionality of the pass. |
| 67 | + |
| 68 | + set len [string length [project::rev num]] |
| 69 | + set myatfmt %${len}s |
| 70 | + incr len 6 |
| 71 | + set mycsfmt %${len}s |
| 66 | 72 | |
| 67 | 73 | cyclebreaker precmd [myproc BreakBackwardBranches] |
| 74 | + cyclebreaker savecmd [myproc KeepOrder] |
| 68 | 75 | cyclebreaker breakcmd [myproc BreakCycle] |
| 69 | 76 | |
| 70 | 77 | state transaction { |
| 71 | 78 | LoadCommitOrder |
| 72 | 79 | cyclebreaker run break-all [myproc Changesets] |
| | @@ -88,16 +95,18 @@ |
| 88 | 95 | |
| 89 | 96 | proc Changesets {} { project::rev all } |
| 90 | 97 | |
| 91 | 98 | proc LoadCommitOrder {} { |
| 92 | 99 | ::variable mycset |
| 100 | + ::variable myrevisionchangesets |
| 93 | 101 | |
| 94 | 102 | state transaction { |
| 95 | 103 | foreach {cid pos} [state run { SELECT cid, pos FROM csorder }] { |
| 96 | 104 | set cset [project::rev of $cid] |
| 97 | 105 | $cset setpos $pos |
| 98 | 106 | set mycset($pos) $cset |
| 107 | + lappend myrevisionchangesets $cset |
| 99 | 108 | } |
| 100 | 109 | # Remove the order information now that we have it in |
| 101 | 110 | # memory, so that we can save it once more, for all |
| 102 | 111 | # changesets, while breaking the remaining cycles. |
| 103 | 112 | state run { DELETE FROM csorder } |
| | @@ -301,13 +310,188 @@ |
| 301 | 310 | } |
| 302 | 311 | |
| 303 | 312 | |
| 304 | 313 | # # ## ### ##### ######## ############# |
| 305 | 314 | |
| 315 | + proc KeepOrder {graph at cset} { |
| 316 | + set cid [$cset id] |
| 317 | + |
| 318 | + log write 4 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>" |
| 319 | + |
| 320 | + # We see here a mixture of symbol and revision changesets. |
| 321 | + # The symbol changesets are ignored as irrelevant. |
| 322 | + |
| 323 | + if {[$cset pos] eq ""} return |
| 324 | + |
| 325 | + # For the revision changesets we are sure that they are |
| 326 | + # consumed in the same order as generated by pass 7 |
| 327 | + # (RevTopologicalSort). Per the code in cvs2svn. |
| 328 | + |
| 329 | + # NOTE: I cannot see that. Assume cs A and cs B, not dependent |
| 330 | + # on each other in the set of revisions, now B after A |
| 331 | + # simply means that B has a later time or depends on |
| 332 | + # something wit a later time than A. In the full graph A |
| 333 | + # may now have dependencies which shift it after B, |
| 334 | + # violating the above assumption. |
| 335 | + # |
| 336 | + # Well, it seems to work if I do not make the NTDB root a |
| 337 | + # successor of the regular root. Doing so seems to tangle the |
| 338 | + # changesets into a knots regarding time vs dependencies and |
| 339 | + # trigger such shifts. Keeping these two roots separate OTOH |
| 340 | + # disappears the tangle. So, for now I accept that, and for |
| 341 | + # paranoia I add code which checks this assumption. |
| 342 | + |
| 343 | + struct::set exclude myrevisionchangesets $cset |
| 344 | + |
| 345 | + ::variable mylastpos |
| 346 | + set new [$cset pos] |
| 347 | + |
| 348 | + if {$new != ($mylastpos + 1)} { |
| 349 | + if {$mylastpos < 0} { |
| 350 | + set old "<NONE>" |
| 351 | + } else { |
| 352 | + ::variable mycset |
| 353 | + set old [$mycset($mylastpos) str]@$mylastpos |
| 354 | + } |
| 355 | + |
| 356 | + trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old" |
| 357 | + } |
| 358 | + |
| 359 | + set mylastpos $new |
| 360 | + return |
| 361 | + } |
| 362 | + |
| 363 | + proc FormatTR {graph cset} { |
| 364 | + return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }] |
| 365 | + } |
| 366 | + |
| 367 | + typevariable mylastpos -1 ; # Position of last revision changeset saved. |
| 368 | + typevariable myrevisionchangesets {} ; # Set of revision changesets |
| 369 | + |
| 370 | + typevariable myatfmt ; # Format for log output to gain better alignment of the various columns. |
| 371 | + typevariable mycsfmt ; # Ditto for the changesets. |
| 372 | + |
| 373 | + # # ## ### ##### ######## ############# |
| 374 | + |
| 306 | 375 | proc BreakCycle {graph} { |
| 376 | + # In this pass the cycle breaking can be made a bit more |
| 377 | + # targeted, hence this custom callback. |
| 378 | + # |
| 379 | + # First we use the data remembered by 'SaveOrder', about the |
| 380 | + # last commit position it handled, to deduce the next revision |
| 381 | + # changeset it would encounter. Then we look for the shortest |
| 382 | + # predecessor path from it to all other revision changesets |
| 383 | + # and break this path. Without such a path we fall back to the |
| 384 | + # generic cycle breaker. |
| 385 | + |
| 386 | + ::variable mylastpos |
| 387 | + ::variable mycset |
| 388 | + ::variable myrevisionchangesets |
| 389 | + |
| 390 | + set nextpos [expr {$mylastpos + 1}] |
| 391 | + set next $mycset($nextpos) |
| 392 | + |
| 393 | + puts "** Last: $mylastpos = [$mycset($mylastpos) str] @ [$mycset($mylastpos) pos]" |
| 394 | + puts "** Next: $nextpos = [$next str] @ [$next pos]" |
| 395 | + |
| 396 | + set path [SearchForPath $graph $next $myrevisionchangesets] |
| 397 | + if {[llength $path]} { |
| 398 | + cyclebreaker break-segment $graph $path |
| 399 | + return |
| 400 | + } |
| 401 | + |
| 402 | + # We were unable to find an ordered changeset in the reachable |
| 403 | + # predecessors, fall back to the generic code for breaking the |
| 404 | + # found cycle. |
| 405 | + |
| 307 | 406 | cyclebreaker break $graph |
| 308 | 407 | } |
| 408 | + |
| 409 | + proc SearchForPath {graph n stopnodes} { |
| 410 | + # Search for paths to prerequisites of N. |
| 411 | + # |
| 412 | + # Try to find the shortest dependency path that causes the |
| 413 | + # changeset N to depend (directly or indirectly) on one of the |
| 414 | + # changesets contained in STOPNODES. |
| 415 | + # |
| 416 | + # We consider direct and indirect dependencies in the sense |
| 417 | + # that the changeset can be reached by following a chain of |
| 418 | + # predecessor nodes. |
| 419 | + # |
| 420 | + # When one of the csets in STOPNODES is found, we terminate |
| 421 | + # the search and return the path from that cset to N. If no |
| 422 | + # path is found to a node in STOP_SET, we return the empty |
| 423 | + # list/path. |
| 424 | + |
| 425 | + # This is in essence a multi-destination Dijkstra starting at |
| 426 | + # N which stops when one of the destinations in STOPNODES has |
| 427 | + # been reached, traversing the predecessor arcs. |
| 428 | + |
| 429 | + # REACHABLE :: array (NODE -> list (STEPS, PREVIOUS)) |
| 430 | + # |
| 431 | + # Semantics: NODE can be reached from N in STEPS steps, and |
| 432 | + # PREVIOUS is the previous node in the path which reached it, |
| 433 | + # allowing us at the end to construct the full path by |
| 434 | + # following these backlinks from the found destination. N is |
| 435 | + # only included as a key if there is a loop leading back to |
| 436 | + # it. |
| 437 | + |
| 438 | + # PENDING :: list (list (NODE, STEPS)) |
| 439 | + # |
| 440 | + # Semantics: A list of possibilities that still have to be |
| 441 | + # investigated, where STEPS is the number of steps to get to |
| 442 | + # NODE. |
| 443 | + |
| 444 | + array set reachable {} |
| 445 | + set pending [list [list $n 0]] |
| 446 | + set at 0 |
| 447 | + |
| 448 | + puts "** Searching shortest path ..." |
| 449 | + |
| 450 | + while {$at < [llength $pending]} { |
| 451 | + struct::list assign [lindex $pending $at] current steps |
| 452 | + |
| 453 | + #puts "** [lindex $pending $at] ** [$current str] **" |
| 454 | + incr at |
| 455 | + |
| 456 | + # Process the possibility. This is a breadth-first traversal. |
| 457 | + incr steps |
| 458 | + foreach pre [$graph nodes -in $current] { |
| 459 | + # Since the search is breadth-first, we only have to # |
| 460 | + # set nodes that don't already exist. If they do they |
| 461 | + # have been reached already on a shorter path. |
| 462 | + |
| 463 | + if {[info exists reachable($pre)]} continue |
| 464 | + |
| 465 | + set reachable($pre) [list $steps $current] |
| 466 | + lappend pending [list $pre $steps] |
| 467 | + |
| 468 | + # Continue the search while have not reached any of |
| 469 | + # our destinations? |
| 470 | + if {![struct::set contain $pre $stopnodes]} continue |
| 471 | + |
| 472 | + # We have arrived, PRE is one of the destination; now |
| 473 | + # construct and return the path to it from N by |
| 474 | + # following the backlinks in the search state. |
| 475 | + set path [list $pre] |
| 476 | + while {1} { |
| 477 | + set pre [lindex $reachable($pre) 1] |
| 478 | + if {$pre eq $n} break |
| 479 | + lappend path $pre |
| 480 | + } |
| 481 | + lappend path $n |
| 482 | + |
| 483 | + puts "** Searching shortest path ... Found ([project rev strlist $path])" |
| 484 | + return $path |
| 485 | + } |
| 486 | + } |
| 487 | + |
| 488 | + puts "** Searching shortest path ... Not found" |
| 489 | + |
| 490 | + # No path found. |
| 491 | + return {} |
| 492 | + } |
| 309 | 493 | |
| 310 | 494 | # # ## ### ##### ######## ############# |
| 311 | 495 | |
| 312 | 496 | typevariable mycset -array {} ; # Map from commit positions to the |
| 313 | 497 | # changeset (object ref) at that |
| 314 | 498 | |