Fossil SCM
Moved the existing successor/predecessor code from main class to the proper singleton. Fixed config of main class, isn't simple dispatch any longer. Simplified calculation of the readable representation of changesets and removed code which has become superfluous.
Commit
70d22835649e2e4c8b78f6808a0a085ccae98952
Parent
4b15fa348d8f98e…
1 file changed
+220
-204
+220
-204
| --- tools/cvs2fossil/lib/c2f_prev.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | ||
| @@ -21,11 +21,10 @@ | ||
| 21 | 21 | package require vc::tools::misc ; # Text formatting |
| 22 | 22 | package require vc::tools::trouble ; # Error reporting. |
| 23 | 23 | package require vc::tools::log ; # User feedback. |
| 24 | 24 | package require vc::fossil::import::cvs::state ; # State storage. |
| 25 | 25 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 26 | -package require vc::fossil::import::cvs::project::sym ; # Project level symbols | |
| 27 | 26 | |
| 28 | 27 | # # ## ### ##### ######## ############# ##################### |
| 29 | 28 | ## |
| 30 | 29 | |
| 31 | 30 | snit::type ::vc::fossil::import::cvs::project::rev { |
| @@ -57,19 +56,16 @@ | ||
| 57 | 56 | } |
| 58 | 57 | |
| 59 | 58 | method str {} { |
| 60 | 59 | set str "<" |
| 61 | 60 | set detail "" |
| 62 | - if {$mytype eq "sym"} { | |
| 63 | - struct::list assign [state run { | |
| 64 | - SELECT T.name, S.name | |
| 65 | - FROM symtype T, symbol S | |
| 61 | + if {[$mytypeobj bysymbol]} { | |
| 62 | + set detail " '[state one { | |
| 63 | + SELECT S.name | |
| 64 | + FROM symbol S | |
| 66 | 65 | WHERE S.sid = $mysrcid |
| 67 | - AND T.tid = S.type | |
| 68 | - }] stype detail | |
| 69 | - append str $stype " " | |
| 70 | - set detail " '$detail'" | |
| 66 | + }]'" | |
| 71 | 67 | } |
| 72 | 68 | append str "$mytype ${myid}${detail}>" |
| 73 | 69 | return $str |
| 74 | 70 | } |
| 75 | 71 | |
| @@ -399,11 +395,12 @@ | ||
| 399 | 395 | # known. |
| 400 | 396 | |
| 401 | 397 | # # ## ### ##### ######## ############# |
| 402 | 398 | ## Internal methods |
| 403 | 399 | |
| 404 | - typevariable mycounter 0 ; # Id counter for csets. Last id used. | |
| 400 | + typevariable mycounter 0 ; # Id counter for csets. Last id | |
| 401 | + # used. | |
| 405 | 402 | typevariable mycstype -array {} ; # Map cstypes (names) to persistent |
| 406 | 403 | # ids. Note that we have to keep |
| 407 | 404 | # the names in the table 'cstype' |
| 408 | 405 | # in sync with the names of the |
| 409 | 406 | # helper singletons. |
| @@ -421,197 +418,10 @@ | ||
| 421 | 418 | return |
| 422 | 419 | } |
| 423 | 420 | |
| 424 | 421 | typemethod num {} { return $mycounter } |
| 425 | 422 | |
| 426 | - proc PullInternalSuccessorRevisions {dv revisions} { | |
| 427 | - upvar 1 $dv dependencies | |
| 428 | - set theset ('[join $revisions {','}]') | |
| 429 | - | |
| 430 | - # See PullSuccessorRevisions below for the main explanation of | |
| 431 | - # the various cases. This piece is special in that it | |
| 432 | - # restricts the successors we look for to the same set of | |
| 433 | - # revisions we start from. Sensible as we are looking for | |
| 434 | - # changeset internal dependencies. | |
| 435 | - | |
| 436 | - array set dep {} | |
| 437 | - | |
| 438 | - foreach {rid child} [state run " | |
| 439 | - -- (1) Primary child | |
| 440 | - SELECT R.rid, R.child | |
| 441 | - FROM revision R | |
| 442 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 443 | - AND R.child IS NOT NULL -- Has primary child | |
| 444 | - AND R.child IN $theset -- Which is also of interest | |
| 445 | - UNION | |
| 446 | - -- (2) Secondary (branch) children | |
| 447 | - SELECT R.rid, B.brid | |
| 448 | - FROM revision R, revisionbranchchildren B | |
| 449 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 450 | - AND R.rid = B.rid -- Select subset of branch children | |
| 451 | - AND B.brid IN $theset -- Which is also of interest | |
| 452 | - UNION | |
| 453 | - -- (4) Child of trunk root successor of last NTDB on trunk. | |
| 454 | - SELECT R.rid, RA.child | |
| 455 | - FROM revision R, revision RA | |
| 456 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 457 | - AND R.isdefault -- Restrict to NTDB | |
| 458 | - AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk | |
| 459 | - AND RA.rid = R.dbchild -- Go directly to trunk root | |
| 460 | - AND RA.child IS NOT NULL -- Has primary child. | |
| 461 | - AND RA.child IN $theset -- Which is also of interest | |
| 462 | - "] { | |
| 463 | - # Consider moving this to the integrity module. | |
| 464 | - integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 465 | - lappend dependencies($rid) $child | |
| 466 | - set dep($rid,$child) . | |
| 467 | - } | |
| 468 | - | |
| 469 | - # The sql statements above looks only for direct dependencies | |
| 470 | - # between revision in the changeset. However due to the | |
| 471 | - # vagaries of meta data it is possible for two revisions of | |
| 472 | - # the same file to end up in the same changeset, without a | |
| 473 | - # direct dependency between them. However we know that there | |
| 474 | - # has to be a an indirect dependency, be it through primary | |
| 475 | - # children, branch children, or a combination thereof. | |
| 476 | - | |
| 477 | - # We now fill in these pseudo-dependencies, if no such | |
| 478 | - # dependency exists already. The direction of the dependency | |
| 479 | - # is actually irrelevant for this. | |
| 480 | - | |
| 481 | - # NOTE: This is different from cvs2svn. Our spiritual ancestor | |
| 482 | - # does not use such pseudo-dependencies, however it uses a | |
| 483 | - # COMMIT_THRESHOLD, a time interval commits should fall. This | |
| 484 | - # will greatly reduces the risk of getting far separated | |
| 485 | - # revisions of the same file into one changeset. | |
| 486 | - | |
| 487 | - # We allow revisions to be far apart in time in the same | |
| 488 | - # changeset, but need the pseudo-dependencies for this. | |
| 489 | - | |
| 490 | - array set fids {} | |
| 491 | - foreach {rid fid} [state run " | |
| 492 | - SELECT R.rid, R.fid FROM revision R WHERE R.rid IN $theset | |
| 493 | - "] { lappend fids($fid) $rid } | |
| 494 | - | |
| 495 | - foreach {fid rids} [array get fids] { | |
| 496 | - if {[llength $rids] < 2} continue | |
| 497 | - foreach a $rids { | |
| 498 | - foreach b $rids { | |
| 499 | - if {$a == $b} continue | |
| 500 | - if {[info exists dep($a,$b)]} continue | |
| 501 | - if {[info exists dep($b,$a)]} continue | |
| 502 | - lappend dependencies($a) $b | |
| 503 | - set dep($a,$b) . | |
| 504 | - set dep($b,$a) . | |
| 505 | - } | |
| 506 | - } | |
| 507 | - } | |
| 508 | - return | |
| 509 | - } | |
| 510 | - | |
| 511 | - proc PullSuccessorRevisions {dv revisions} { | |
| 512 | - upvar 1 $dv dependencies | |
| 513 | - set theset ('[join $revisions {','}]') | |
| 514 | - | |
| 515 | - # The following cases specify when a revision S is a successor | |
| 516 | - # of a revision R. Each of the cases translates into one of | |
| 517 | - # the branches of the SQL UNION coming below. | |
| 518 | - # | |
| 519 | - # (1) S can be a primary child of R, i.e. in the same LOD. R | |
| 520 | - # references S directly. R.child = S(.rid), if it exists. | |
| 521 | - # | |
| 522 | - # (2) S can be a secondary, i.e. branch, child of R. Here the | |
| 523 | - # link is made through the helper table | |
| 524 | - # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = | |
| 525 | - # S(.rid) | |
| 526 | - # | |
| 527 | - # (3) Originally this use case defined the root of a detached | |
| 528 | - # NTDB as the successor of the trunk root. This leads to a | |
| 529 | - # bad tangle later on. With a detached NTDB the original | |
| 530 | - # trunk root revision was removed as irrelevant, allowing | |
| 531 | - # the nominal root to be later in time than the NTDB | |
| 532 | - # root. Now setting this dependency will be backward in | |
| 533 | - # time. REMOVED. | |
| 534 | - # | |
| 535 | - # (4) If R is the last of the NTDB revisions which belong to | |
| 536 | - # the trunk, then the primary child of the trunk root (the | |
| 537 | - # '1.2' revision) is a successor, if it exists. | |
| 538 | - | |
| 539 | - foreach {rid child} [state run " | |
| 540 | - -- (1) Primary child | |
| 541 | - SELECT R.rid, R.child | |
| 542 | - FROM revision R | |
| 543 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 544 | - AND R.child IS NOT NULL -- Has primary child | |
| 545 | - UNION | |
| 546 | - -- (2) Secondary (branch) children | |
| 547 | - SELECT R.rid, B.brid | |
| 548 | - FROM revision R, revisionbranchchildren B | |
| 549 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 550 | - AND R.rid = B.rid -- Select subset of branch children | |
| 551 | - UNION | |
| 552 | - -- (4) Child of trunk root successor of last NTDB on trunk. | |
| 553 | - SELECT R.rid, RA.child | |
| 554 | - FROM revision R, revision RA | |
| 555 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 556 | - AND R.isdefault -- Restrict to NTDB | |
| 557 | - AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk | |
| 558 | - AND RA.rid = R.dbchild -- Go directly to trunk root | |
| 559 | - AND RA.child IS NOT NULL -- Has primary child. | |
| 560 | - "] { | |
| 561 | - # Consider moving this to the integrity module. | |
| 562 | - integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 563 | - lappend dependencies($rid) $child | |
| 564 | - } | |
| 565 | - return | |
| 566 | - } | |
| 567 | - | |
| 568 | - proc PullPredecessorRevisions {dv revisions} { | |
| 569 | - upvar 1 $dv dependencies | |
| 570 | - set theset ('[join $revisions {','}]') | |
| 571 | - | |
| 572 | - # The following cases specify when a revision P is a | |
| 573 | - # predecessor of a revision R. Each of the cases translates | |
| 574 | - # into one of the branches of the SQL UNION coming below. | |
| 575 | - # | |
| 576 | - # (1) The immediate parent R.parent of R is a predecessor of | |
| 577 | - # R. NOTE: This is true for R either primary or secondary | |
| 578 | - # child of P. It not necessary to distinguish the two | |
| 579 | - # cases, in contrast to the code retrieving the successor | |
| 580 | - # information. | |
| 581 | - # | |
| 582 | - # (2) The complement of successor case (3). The trunk root is | |
| 583 | - # a predecessor of a NTDB root. REMOVED. See | |
| 584 | - # PullSuccessorRevisions for the explanation. | |
| 585 | - # | |
| 586 | - # (3) The complement of successor case (4). The last NTDB | |
| 587 | - # revision belonging to the trunk is a predecessor of the | |
| 588 | - # primary child of the trunk root (The '1.2' revision). | |
| 589 | - | |
| 590 | - foreach {rid parent} [state run " | |
| 591 | - -- (1) Primary parent, can be in different LOD for first in a branch | |
| 592 | - SELECT R.rid, R.parent | |
| 593 | - FROM revision R | |
| 594 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 595 | - AND R.parent IS NOT NULL -- Has primary parent | |
| 596 | - UNION | |
| 597 | - -- (3) Last NTDB on trunk is predecessor of child of trunk root | |
| 598 | - SELECT R.rid, RA.dbparent | |
| 599 | - FROM revision R, revision RA | |
| 600 | - WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 601 | - AND NOT R.isdefault -- not on NTDB | |
| 602 | - AND R.parent IS NOT NULL -- which are not root | |
| 603 | - AND RA.rid = R.parent -- go to their parent | |
| 604 | - AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root | |
| 605 | - "] { | |
| 606 | - # Consider moving this to the integrity module. | |
| 607 | - integrity assert {$rid != $parent} {Revision $rid depends on itself.} | |
| 608 | - lappend dependencies($rid) $parent | |
| 609 | - } | |
| 610 | - return | |
| 611 | - } | |
| 612 | - | |
| 613 | 423 | proc InitializeBreakState {revisions} { |
| 614 | 424 | upvar 1 pos pos cross cross range range depc depc delta delta \ |
| 615 | 425 | dependencies dependencies |
| 616 | 426 | |
| 617 | 427 | # First we create a map of positions to make it easier to |
| @@ -638,11 +448,11 @@ | ||
| 638 | 448 | # to ensure that the following loop runs correctly. |
| 639 | 449 | # |
| 640 | 450 | # Note 2: start == end is not possible. It indicates a |
| 641 | 451 | # self-dependency due to the uniqueness of positions, |
| 642 | 452 | # and that is something we have ruled out already, see |
| 643 | - # PullInternalSuccessorRevisions. | |
| 453 | + # 'rev internalsuccessors'. | |
| 644 | 454 | |
| 645 | 455 | foreach {rid children} [array get dependencies] { |
| 646 | 456 | foreach child $children { |
| 647 | 457 | set dkey [list $rid $child] |
| 648 | 458 | set start $pos($rid) |
| @@ -829,11 +639,10 @@ | ||
| 829 | 639 | # the revision, there can |
| 830 | 640 | # however also be one or more |
| 831 | 641 | # additional symbol changesets |
| 832 | 642 | # which use it, hence a list. |
| 833 | 643 | typevariable myidmap -array {} ; # Map from changeset id to changeset. |
| 834 | - typevariable mybranchcode {} ; # Local copy of project::sym/mybranch. | |
| 835 | 644 | |
| 836 | 645 | typemethod all {} { return $mychangesets } |
| 837 | 646 | typemethod of {id} { return $myidmap($id) } |
| 838 | 647 | typemethod ofrev {id} { return $myrevmap($id) } |
| 839 | 648 | |
| @@ -840,11 +649,10 @@ | ||
| 840 | 649 | # # ## ### ##### ######## ############# |
| 841 | 650 | ## Configuration |
| 842 | 651 | |
| 843 | 652 | pragma -hastypeinfo no ; # no type introspection |
| 844 | 653 | pragma -hasinfo no ; # no object introspection |
| 845 | - pragma -simpledispatch yes ; # simple fast dispatch | |
| 846 | 654 | |
| 847 | 655 | # # ## ### ##### ######## ############# |
| 848 | 656 | } |
| 849 | 657 | |
| 850 | 658 | # # ## ### ##### ######## ############# ##################### |
| @@ -866,18 +674,230 @@ | ||
| 866 | 674 | "] |
| 867 | 675 | } |
| 868 | 676 | |
| 869 | 677 | # var(dv) = dict (revision -> list (revision)) |
| 870 | 678 | typemethod internalsuccessors {dv revisions} { |
| 679 | + upvar 1 $dv dependencies | |
| 680 | + set theset ('[join $revisions {','}]') | |
| 681 | + | |
| 682 | + # See 'successors' below for the main explanation of | |
| 683 | + # the various cases. This piece is special in that it | |
| 684 | + # restricts the successors we look for to the same set of | |
| 685 | + # revisions we start from. Sensible as we are looking for | |
| 686 | + # changeset internal dependencies. | |
| 687 | + | |
| 688 | + array set dep {} | |
| 689 | + | |
| 690 | + foreach {rid child} [state run " | |
| 691 | + -- (1) Primary child | |
| 692 | + SELECT R.rid, R.child | |
| 693 | + FROM revision R | |
| 694 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 695 | + AND R.child IS NOT NULL -- Has primary child | |
| 696 | + AND R.child IN $theset -- Which is also of interest | |
| 697 | + UNION | |
| 698 | + -- (2) Secondary (branch) children | |
| 699 | + SELECT R.rid, B.brid | |
| 700 | + FROM revision R, revisionbranchchildren B | |
| 701 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 702 | + AND R.rid = B.rid -- Select subset of branch children | |
| 703 | + AND B.brid IN $theset -- Which is also of interest | |
| 704 | + UNION | |
| 705 | + -- (4) Child of trunk root successor of last NTDB on trunk. | |
| 706 | + SELECT R.rid, RA.child | |
| 707 | + FROM revision R, revision RA | |
| 708 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 709 | + AND R.isdefault -- Restrict to NTDB | |
| 710 | + AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk | |
| 711 | + AND RA.rid = R.dbchild -- Go directly to trunk root | |
| 712 | + AND RA.child IS NOT NULL -- Has primary child. | |
| 713 | + AND RA.child IN $theset -- Which is also of interest | |
| 714 | + "] { | |
| 715 | + # Consider moving this to the integrity module. | |
| 716 | + integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 717 | + lappend dependencies($rid) $child | |
| 718 | + set dep($rid,$child) . | |
| 719 | + } | |
| 720 | + | |
| 721 | + # The sql statements above looks only for direct dependencies | |
| 722 | + # between revision in the changeset. However due to the | |
| 723 | + # vagaries of meta data it is possible for two revisions of | |
| 724 | + # the same file to end up in the same changeset, without a | |
| 725 | + # direct dependency between them. However we know that there | |
| 726 | + # has to be a an indirect dependency, be it through primary | |
| 727 | + # children, branch children, or a combination thereof. | |
| 728 | + | |
| 729 | + # We now fill in these pseudo-dependencies, if no such | |
| 730 | + # dependency exists already. The direction of the dependency | |
| 731 | + # is actually irrelevant for this. | |
| 732 | + | |
| 733 | + # NOTE: This is different from cvs2svn. Our spiritual ancestor | |
| 734 | + # does not use such pseudo-dependencies, however it uses a | |
| 735 | + # COMMIT_THRESHOLD, a time interval commits should fall. This | |
| 736 | + # will greatly reduces the risk of getting far separated | |
| 737 | + # revisions of the same file into one changeset. | |
| 738 | + | |
| 739 | + # We allow revisions to be far apart in time in the same | |
| 740 | + # changeset, but need the pseudo-dependencies for this. | |
| 741 | + | |
| 742 | + array set fids {} | |
| 743 | + foreach {rid fid} [state run " | |
| 744 | + SELECT R.rid, R.fid FROM revision R WHERE R.rid IN $theset | |
| 745 | + "] { lappend fids($fid) $rid } | |
| 746 | + | |
| 747 | + foreach {fid rids} [array get fids] { | |
| 748 | + if {[llength $rids] < 2} continue | |
| 749 | + foreach a $rids { | |
| 750 | + foreach b $rids { | |
| 751 | + if {$a == $b} continue | |
| 752 | + if {[info exists dep($a,$b)]} continue | |
| 753 | + if {[info exists dep($b,$a)]} continue | |
| 754 | + lappend dependencies($a) $b | |
| 755 | + set dep($a,$b) . | |
| 756 | + set dep($b,$a) . | |
| 757 | + } | |
| 758 | + } | |
| 759 | + } | |
| 760 | + return | |
| 871 | 761 | } |
| 872 | 762 | |
| 873 | 763 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 874 | 764 | typemethod successors {dv revisions} { |
| 765 | + upvar 1 $dv dependencies | |
| 766 | + set theset ('[join $revisions {','}]') | |
| 767 | + | |
| 768 | + # The following cases specify when a revision S is a successor | |
| 769 | + # of a revision R. Each of the cases translates into one of | |
| 770 | + # the branches of the SQL UNION coming below. | |
| 771 | + # | |
| 772 | + # (1) S can be a primary child of R, i.e. in the same LOD. R | |
| 773 | + # references S directly. R.child = S(.rid), if it exists. | |
| 774 | + # | |
| 775 | + # (2) S can be a secondary, i.e. branch, child of R. Here the | |
| 776 | + # link is made through the helper table | |
| 777 | + # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = | |
| 778 | + # S(.rid) | |
| 779 | + # | |
| 780 | + # (3) Originally this use case defined the root of a detached | |
| 781 | + # NTDB as the successor of the trunk root. This leads to a | |
| 782 | + # bad tangle later on. With a detached NTDB the original | |
| 783 | + # trunk root revision was removed as irrelevant, allowing | |
| 784 | + # the nominal root to be later in time than the NTDB | |
| 785 | + # root. Now setting this dependency will be backward in | |
| 786 | + # time. REMOVED. | |
| 787 | + # | |
| 788 | + # (4) If R is the last of the NTDB revisions which belong to | |
| 789 | + # the trunk, then the primary child of the trunk root (the | |
| 790 | + # '1.2' revision) is a successor, if it exists. | |
| 791 | + | |
| 792 | + # Note that the branches spawned from the revisions, and the | |
| 793 | + # tags associated with them are successors as well. | |
| 794 | + | |
| 795 | + foreach {rid child} [state run " | |
| 796 | + -- (1) Primary child | |
| 797 | + SELECT R.rid, R.child | |
| 798 | + FROM revision R | |
| 799 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 800 | + AND R.child IS NOT NULL -- Has primary child | |
| 801 | + UNION | |
| 802 | + -- (2) Secondary (branch) children | |
| 803 | + SELECT R.rid, B.brid | |
| 804 | + FROM revision R, revisionbranchchildren B | |
| 805 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 806 | + AND R.rid = B.rid -- Select subset of branch children | |
| 807 | + UNION | |
| 808 | + -- (4) Child of trunk root successor of last NTDB on trunk. | |
| 809 | + SELECT R.rid, RA.child | |
| 810 | + FROM revision R, revision RA | |
| 811 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 812 | + AND R.isdefault -- Restrict to NTDB | |
| 813 | + AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk | |
| 814 | + AND RA.rid = R.dbchild -- Go directly to trunk root | |
| 815 | + AND RA.child IS NOT NULL -- Has primary child. | |
| 816 | + "] { | |
| 817 | + # Consider moving this to the integrity module. | |
| 818 | + integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 819 | + lappend dependencies([list rev $rid]) [list rev $child] | |
| 820 | + } | |
| 821 | + foreach {rid child} [state run " | |
| 822 | + SELECT R.rid, T.tid | |
| 823 | + FROM revision R, tag T | |
| 824 | + WHERE R.rid in $theset | |
| 825 | + AND T.rev = R.rid | |
| 826 | + "] { | |
| 827 | + lappend dependencies([list rev $rid]) [list sym::tag $child] | |
| 828 | + } | |
| 829 | + foreach {rid child} [state run " | |
| 830 | + SELECT R.rid, B.bid | |
| 831 | + FROM revision R, branch B | |
| 832 | + WHERE R.rid in $theset | |
| 833 | + AND B.root = R.rid | |
| 834 | + "] { | |
| 835 | + lappend dependencies([list rev $rid]) [list sym::branch $child] | |
| 836 | + } | |
| 837 | + return | |
| 875 | 838 | } |
| 876 | 839 | |
| 877 | 840 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 878 | 841 | typemethod predecessors {dv revisions} { |
| 842 | + upvar 1 $dv dependencies | |
| 843 | + set theset ('[join $revisions {','}]') | |
| 844 | + | |
| 845 | + # The following cases specify when a revision P is a | |
| 846 | + # predecessor of a revision R. Each of the cases translates | |
| 847 | + # into one of the branches of the SQL UNION coming below. | |
| 848 | + # | |
| 849 | + # (1) The immediate parent R.parent of R is a predecessor of | |
| 850 | + # R. NOTE: This is true for R either primary or secondary | |
| 851 | + # child of P. It not necessary to distinguish the two | |
| 852 | + # cases, in contrast to the code retrieving the successor | |
| 853 | + # information. | |
| 854 | + # | |
| 855 | + # (2) The complement of successor case (3). The trunk root is | |
| 856 | + # a predecessor of a NTDB root. REMOVED. See 'successors' | |
| 857 | + # for the explanation. | |
| 858 | + # | |
| 859 | + # (3) The complement of successor case (4). The last NTDB | |
| 860 | + # revision belonging to the trunk is a predecessor of the | |
| 861 | + # primary child of the trunk root (The '1.2' revision). | |
| 862 | + | |
| 863 | + foreach {rid parent} [state run " | |
| 864 | + -- (1) Primary parent, can be in different LOD for first in a branch | |
| 865 | + SELECT R.rid, R.parent | |
| 866 | + FROM revision R | |
| 867 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 868 | + AND R.parent IS NOT NULL -- Has primary parent | |
| 869 | + UNION | |
| 870 | + -- (3) Last NTDB on trunk is predecessor of child of trunk root | |
| 871 | + SELECT R.rid, RA.dbparent | |
| 872 | + FROM revision R, revision RA | |
| 873 | + WHERE R.rid IN $theset -- Restrict to revisions of interest | |
| 874 | + AND NOT R.isdefault -- not on NTDB | |
| 875 | + AND R.parent IS NOT NULL -- which are not root | |
| 876 | + AND RA.rid = R.parent -- go to their parent | |
| 877 | + AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root | |
| 878 | + "] { | |
| 879 | + # Consider moving this to the integrity module. | |
| 880 | + integrity assert {$rid != $parent} {Revision $rid depends on itself.} | |
| 881 | + lappend dependencies([list rev $rid]) [list rev $parent] | |
| 882 | + } | |
| 883 | + | |
| 884 | + # The revisions which are the first on a branch have that | |
| 885 | + # branch as their predecessor. Note that revisions cannot be | |
| 886 | + # on tags in the same manner, so tags cannot be predecessors | |
| 887 | + # of revisions. This complements that they have no successors | |
| 888 | + # (See sym::tag/successors). | |
| 889 | + | |
| 890 | + foreach {rid parent} [state run " | |
| 891 | + SELECT R.rid B.bid | |
| 892 | + FROM revision R, branch B | |
| 893 | + WHERE R.rid IN $theset | |
| 894 | + AND B.first = R.rid | |
| 895 | + "] { | |
| 896 | + lappend dependencies([list rev $rid]) [list sym::branch $parent] | |
| 897 | + } | |
| 898 | + return | |
| 879 | 899 | } |
| 880 | 900 | } |
| 881 | 901 | |
| 882 | 902 | # # ## ### ##### ######## ############# ##################### |
| 883 | 903 | ## Helper singleton. Commands for tag symbol changesets. |
| @@ -936,14 +956,10 @@ | ||
| 936 | 956 | namespace eval ::vc::fossil::import::cvs::project { |
| 937 | 957 | namespace export rev |
| 938 | 958 | namespace eval rev { |
| 939 | 959 | namespace import ::vc::fossil::import::cvs::state |
| 940 | 960 | namespace import ::vc::fossil::import::cvs::integrity |
| 941 | - namespace eval project { | |
| 942 | - namespace import ::vc::fossil::import::cvs::project::sym | |
| 943 | - } | |
| 944 | - ::variable mybranchcode [project::sym branch] | |
| 945 | 961 | namespace import ::vc::tools::misc::* |
| 946 | 962 | namespace import ::vc::tools::trouble |
| 947 | 963 | namespace import ::vc::tools::log |
| 948 | 964 | log register csets |
| 949 | 965 | |
| 950 | 966 |
| --- tools/cvs2fossil/lib/c2f_prev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | |
| @@ -21,11 +21,10 @@ | |
| 21 | package require vc::tools::misc ; # Text formatting |
| 22 | package require vc::tools::trouble ; # Error reporting. |
| 23 | package require vc::tools::log ; # User feedback. |
| 24 | package require vc::fossil::import::cvs::state ; # State storage. |
| 25 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 26 | package require vc::fossil::import::cvs::project::sym ; # Project level symbols |
| 27 | |
| 28 | # # ## ### ##### ######## ############# ##################### |
| 29 | ## |
| 30 | |
| 31 | snit::type ::vc::fossil::import::cvs::project::rev { |
| @@ -57,19 +56,16 @@ | |
| 57 | } |
| 58 | |
| 59 | method str {} { |
| 60 | set str "<" |
| 61 | set detail "" |
| 62 | if {$mytype eq "sym"} { |
| 63 | struct::list assign [state run { |
| 64 | SELECT T.name, S.name |
| 65 | FROM symtype T, symbol S |
| 66 | WHERE S.sid = $mysrcid |
| 67 | AND T.tid = S.type |
| 68 | }] stype detail |
| 69 | append str $stype " " |
| 70 | set detail " '$detail'" |
| 71 | } |
| 72 | append str "$mytype ${myid}${detail}>" |
| 73 | return $str |
| 74 | } |
| 75 | |
| @@ -399,11 +395,12 @@ | |
| 399 | # known. |
| 400 | |
| 401 | # # ## ### ##### ######## ############# |
| 402 | ## Internal methods |
| 403 | |
| 404 | typevariable mycounter 0 ; # Id counter for csets. Last id used. |
| 405 | typevariable mycstype -array {} ; # Map cstypes (names) to persistent |
| 406 | # ids. Note that we have to keep |
| 407 | # the names in the table 'cstype' |
| 408 | # in sync with the names of the |
| 409 | # helper singletons. |
| @@ -421,197 +418,10 @@ | |
| 421 | return |
| 422 | } |
| 423 | |
| 424 | typemethod num {} { return $mycounter } |
| 425 | |
| 426 | proc PullInternalSuccessorRevisions {dv revisions} { |
| 427 | upvar 1 $dv dependencies |
| 428 | set theset ('[join $revisions {','}]') |
| 429 | |
| 430 | # See PullSuccessorRevisions below for the main explanation of |
| 431 | # the various cases. This piece is special in that it |
| 432 | # restricts the successors we look for to the same set of |
| 433 | # revisions we start from. Sensible as we are looking for |
| 434 | # changeset internal dependencies. |
| 435 | |
| 436 | array set dep {} |
| 437 | |
| 438 | foreach {rid child} [state run " |
| 439 | -- (1) Primary child |
| 440 | SELECT R.rid, R.child |
| 441 | FROM revision R |
| 442 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 443 | AND R.child IS NOT NULL -- Has primary child |
| 444 | AND R.child IN $theset -- Which is also of interest |
| 445 | UNION |
| 446 | -- (2) Secondary (branch) children |
| 447 | SELECT R.rid, B.brid |
| 448 | FROM revision R, revisionbranchchildren B |
| 449 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 450 | AND R.rid = B.rid -- Select subset of branch children |
| 451 | AND B.brid IN $theset -- Which is also of interest |
| 452 | UNION |
| 453 | -- (4) Child of trunk root successor of last NTDB on trunk. |
| 454 | SELECT R.rid, RA.child |
| 455 | FROM revision R, revision RA |
| 456 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 457 | AND R.isdefault -- Restrict to NTDB |
| 458 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 459 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 460 | AND RA.child IS NOT NULL -- Has primary child. |
| 461 | AND RA.child IN $theset -- Which is also of interest |
| 462 | "] { |
| 463 | # Consider moving this to the integrity module. |
| 464 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 465 | lappend dependencies($rid) $child |
| 466 | set dep($rid,$child) . |
| 467 | } |
| 468 | |
| 469 | # The sql statements above looks only for direct dependencies |
| 470 | # between revision in the changeset. However due to the |
| 471 | # vagaries of meta data it is possible for two revisions of |
| 472 | # the same file to end up in the same changeset, without a |
| 473 | # direct dependency between them. However we know that there |
| 474 | # has to be a an indirect dependency, be it through primary |
| 475 | # children, branch children, or a combination thereof. |
| 476 | |
| 477 | # We now fill in these pseudo-dependencies, if no such |
| 478 | # dependency exists already. The direction of the dependency |
| 479 | # is actually irrelevant for this. |
| 480 | |
| 481 | # NOTE: This is different from cvs2svn. Our spiritual ancestor |
| 482 | # does not use such pseudo-dependencies, however it uses a |
| 483 | # COMMIT_THRESHOLD, a time interval commits should fall. This |
| 484 | # will greatly reduces the risk of getting far separated |
| 485 | # revisions of the same file into one changeset. |
| 486 | |
| 487 | # We allow revisions to be far apart in time in the same |
| 488 | # changeset, but need the pseudo-dependencies for this. |
| 489 | |
| 490 | array set fids {} |
| 491 | foreach {rid fid} [state run " |
| 492 | SELECT R.rid, R.fid FROM revision R WHERE R.rid IN $theset |
| 493 | "] { lappend fids($fid) $rid } |
| 494 | |
| 495 | foreach {fid rids} [array get fids] { |
| 496 | if {[llength $rids] < 2} continue |
| 497 | foreach a $rids { |
| 498 | foreach b $rids { |
| 499 | if {$a == $b} continue |
| 500 | if {[info exists dep($a,$b)]} continue |
| 501 | if {[info exists dep($b,$a)]} continue |
| 502 | lappend dependencies($a) $b |
| 503 | set dep($a,$b) . |
| 504 | set dep($b,$a) . |
| 505 | } |
| 506 | } |
| 507 | } |
| 508 | return |
| 509 | } |
| 510 | |
| 511 | proc PullSuccessorRevisions {dv revisions} { |
| 512 | upvar 1 $dv dependencies |
| 513 | set theset ('[join $revisions {','}]') |
| 514 | |
| 515 | # The following cases specify when a revision S is a successor |
| 516 | # of a revision R. Each of the cases translates into one of |
| 517 | # the branches of the SQL UNION coming below. |
| 518 | # |
| 519 | # (1) S can be a primary child of R, i.e. in the same LOD. R |
| 520 | # references S directly. R.child = S(.rid), if it exists. |
| 521 | # |
| 522 | # (2) S can be a secondary, i.e. branch, child of R. Here the |
| 523 | # link is made through the helper table |
| 524 | # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = |
| 525 | # S(.rid) |
| 526 | # |
| 527 | # (3) Originally this use case defined the root of a detached |
| 528 | # NTDB as the successor of the trunk root. This leads to a |
| 529 | # bad tangle later on. With a detached NTDB the original |
| 530 | # trunk root revision was removed as irrelevant, allowing |
| 531 | # the nominal root to be later in time than the NTDB |
| 532 | # root. Now setting this dependency will be backward in |
| 533 | # time. REMOVED. |
| 534 | # |
| 535 | # (4) If R is the last of the NTDB revisions which belong to |
| 536 | # the trunk, then the primary child of the trunk root (the |
| 537 | # '1.2' revision) is a successor, if it exists. |
| 538 | |
| 539 | foreach {rid child} [state run " |
| 540 | -- (1) Primary child |
| 541 | SELECT R.rid, R.child |
| 542 | FROM revision R |
| 543 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 544 | AND R.child IS NOT NULL -- Has primary child |
| 545 | UNION |
| 546 | -- (2) Secondary (branch) children |
| 547 | SELECT R.rid, B.brid |
| 548 | FROM revision R, revisionbranchchildren B |
| 549 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 550 | AND R.rid = B.rid -- Select subset of branch children |
| 551 | UNION |
| 552 | -- (4) Child of trunk root successor of last NTDB on trunk. |
| 553 | SELECT R.rid, RA.child |
| 554 | FROM revision R, revision RA |
| 555 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 556 | AND R.isdefault -- Restrict to NTDB |
| 557 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 558 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 559 | AND RA.child IS NOT NULL -- Has primary child. |
| 560 | "] { |
| 561 | # Consider moving this to the integrity module. |
| 562 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 563 | lappend dependencies($rid) $child |
| 564 | } |
| 565 | return |
| 566 | } |
| 567 | |
| 568 | proc PullPredecessorRevisions {dv revisions} { |
| 569 | upvar 1 $dv dependencies |
| 570 | set theset ('[join $revisions {','}]') |
| 571 | |
| 572 | # The following cases specify when a revision P is a |
| 573 | # predecessor of a revision R. Each of the cases translates |
| 574 | # into one of the branches of the SQL UNION coming below. |
| 575 | # |
| 576 | # (1) The immediate parent R.parent of R is a predecessor of |
| 577 | # R. NOTE: This is true for R either primary or secondary |
| 578 | # child of P. It not necessary to distinguish the two |
| 579 | # cases, in contrast to the code retrieving the successor |
| 580 | # information. |
| 581 | # |
| 582 | # (2) The complement of successor case (3). The trunk root is |
| 583 | # a predecessor of a NTDB root. REMOVED. See |
| 584 | # PullSuccessorRevisions for the explanation. |
| 585 | # |
| 586 | # (3) The complement of successor case (4). The last NTDB |
| 587 | # revision belonging to the trunk is a predecessor of the |
| 588 | # primary child of the trunk root (The '1.2' revision). |
| 589 | |
| 590 | foreach {rid parent} [state run " |
| 591 | -- (1) Primary parent, can be in different LOD for first in a branch |
| 592 | SELECT R.rid, R.parent |
| 593 | FROM revision R |
| 594 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 595 | AND R.parent IS NOT NULL -- Has primary parent |
| 596 | UNION |
| 597 | -- (3) Last NTDB on trunk is predecessor of child of trunk root |
| 598 | SELECT R.rid, RA.dbparent |
| 599 | FROM revision R, revision RA |
| 600 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 601 | AND NOT R.isdefault -- not on NTDB |
| 602 | AND R.parent IS NOT NULL -- which are not root |
| 603 | AND RA.rid = R.parent -- go to their parent |
| 604 | AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root |
| 605 | "] { |
| 606 | # Consider moving this to the integrity module. |
| 607 | integrity assert {$rid != $parent} {Revision $rid depends on itself.} |
| 608 | lappend dependencies($rid) $parent |
| 609 | } |
| 610 | return |
| 611 | } |
| 612 | |
| 613 | proc InitializeBreakState {revisions} { |
| 614 | upvar 1 pos pos cross cross range range depc depc delta delta \ |
| 615 | dependencies dependencies |
| 616 | |
| 617 | # First we create a map of positions to make it easier to |
| @@ -638,11 +448,11 @@ | |
| 638 | # to ensure that the following loop runs correctly. |
| 639 | # |
| 640 | # Note 2: start == end is not possible. It indicates a |
| 641 | # self-dependency due to the uniqueness of positions, |
| 642 | # and that is something we have ruled out already, see |
| 643 | # PullInternalSuccessorRevisions. |
| 644 | |
| 645 | foreach {rid children} [array get dependencies] { |
| 646 | foreach child $children { |
| 647 | set dkey [list $rid $child] |
| 648 | set start $pos($rid) |
| @@ -829,11 +639,10 @@ | |
| 829 | # the revision, there can |
| 830 | # however also be one or more |
| 831 | # additional symbol changesets |
| 832 | # which use it, hence a list. |
| 833 | typevariable myidmap -array {} ; # Map from changeset id to changeset. |
| 834 | typevariable mybranchcode {} ; # Local copy of project::sym/mybranch. |
| 835 | |
| 836 | typemethod all {} { return $mychangesets } |
| 837 | typemethod of {id} { return $myidmap($id) } |
| 838 | typemethod ofrev {id} { return $myrevmap($id) } |
| 839 | |
| @@ -840,11 +649,10 @@ | |
| 840 | # # ## ### ##### ######## ############# |
| 841 | ## Configuration |
| 842 | |
| 843 | pragma -hastypeinfo no ; # no type introspection |
| 844 | pragma -hasinfo no ; # no object introspection |
| 845 | pragma -simpledispatch yes ; # simple fast dispatch |
| 846 | |
| 847 | # # ## ### ##### ######## ############# |
| 848 | } |
| 849 | |
| 850 | # # ## ### ##### ######## ############# ##################### |
| @@ -866,18 +674,230 @@ | |
| 866 | "] |
| 867 | } |
| 868 | |
| 869 | # var(dv) = dict (revision -> list (revision)) |
| 870 | typemethod internalsuccessors {dv revisions} { |
| 871 | } |
| 872 | |
| 873 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 874 | typemethod successors {dv revisions} { |
| 875 | } |
| 876 | |
| 877 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 878 | typemethod predecessors {dv revisions} { |
| 879 | } |
| 880 | } |
| 881 | |
| 882 | # # ## ### ##### ######## ############# ##################### |
| 883 | ## Helper singleton. Commands for tag symbol changesets. |
| @@ -936,14 +956,10 @@ | |
| 936 | namespace eval ::vc::fossil::import::cvs::project { |
| 937 | namespace export rev |
| 938 | namespace eval rev { |
| 939 | namespace import ::vc::fossil::import::cvs::state |
| 940 | namespace import ::vc::fossil::import::cvs::integrity |
| 941 | namespace eval project { |
| 942 | namespace import ::vc::fossil::import::cvs::project::sym |
| 943 | } |
| 944 | ::variable mybranchcode [project::sym branch] |
| 945 | namespace import ::vc::tools::misc::* |
| 946 | namespace import ::vc::tools::trouble |
| 947 | namespace import ::vc::tools::log |
| 948 | log register csets |
| 949 | |
| 950 |
| --- tools/cvs2fossil/lib/c2f_prev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | |
| @@ -21,11 +21,10 @@ | |
| 21 | package require vc::tools::misc ; # Text formatting |
| 22 | package require vc::tools::trouble ; # Error reporting. |
| 23 | package require vc::tools::log ; # User feedback. |
| 24 | package require vc::fossil::import::cvs::state ; # State storage. |
| 25 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 26 | |
| 27 | # # ## ### ##### ######## ############# ##################### |
| 28 | ## |
| 29 | |
| 30 | snit::type ::vc::fossil::import::cvs::project::rev { |
| @@ -57,19 +56,16 @@ | |
| 56 | } |
| 57 | |
| 58 | method str {} { |
| 59 | set str "<" |
| 60 | set detail "" |
| 61 | if {[$mytypeobj bysymbol]} { |
| 62 | set detail " '[state one { |
| 63 | SELECT S.name |
| 64 | FROM symbol S |
| 65 | WHERE S.sid = $mysrcid |
| 66 | }]'" |
| 67 | } |
| 68 | append str "$mytype ${myid}${detail}>" |
| 69 | return $str |
| 70 | } |
| 71 | |
| @@ -399,11 +395,12 @@ | |
| 395 | # known. |
| 396 | |
| 397 | # # ## ### ##### ######## ############# |
| 398 | ## Internal methods |
| 399 | |
| 400 | typevariable mycounter 0 ; # Id counter for csets. Last id |
| 401 | # used. |
| 402 | typevariable mycstype -array {} ; # Map cstypes (names) to persistent |
| 403 | # ids. Note that we have to keep |
| 404 | # the names in the table 'cstype' |
| 405 | # in sync with the names of the |
| 406 | # helper singletons. |
| @@ -421,197 +418,10 @@ | |
| 418 | return |
| 419 | } |
| 420 | |
| 421 | typemethod num {} { return $mycounter } |
| 422 | |
| 423 | proc InitializeBreakState {revisions} { |
| 424 | upvar 1 pos pos cross cross range range depc depc delta delta \ |
| 425 | dependencies dependencies |
| 426 | |
| 427 | # First we create a map of positions to make it easier to |
| @@ -638,11 +448,11 @@ | |
| 448 | # to ensure that the following loop runs correctly. |
| 449 | # |
| 450 | # Note 2: start == end is not possible. It indicates a |
| 451 | # self-dependency due to the uniqueness of positions, |
| 452 | # and that is something we have ruled out already, see |
| 453 | # 'rev internalsuccessors'. |
| 454 | |
| 455 | foreach {rid children} [array get dependencies] { |
| 456 | foreach child $children { |
| 457 | set dkey [list $rid $child] |
| 458 | set start $pos($rid) |
| @@ -829,11 +639,10 @@ | |
| 639 | # the revision, there can |
| 640 | # however also be one or more |
| 641 | # additional symbol changesets |
| 642 | # which use it, hence a list. |
| 643 | typevariable myidmap -array {} ; # Map from changeset id to changeset. |
| 644 | |
| 645 | typemethod all {} { return $mychangesets } |
| 646 | typemethod of {id} { return $myidmap($id) } |
| 647 | typemethod ofrev {id} { return $myrevmap($id) } |
| 648 | |
| @@ -840,11 +649,10 @@ | |
| 649 | # # ## ### ##### ######## ############# |
| 650 | ## Configuration |
| 651 | |
| 652 | pragma -hastypeinfo no ; # no type introspection |
| 653 | pragma -hasinfo no ; # no object introspection |
| 654 | |
| 655 | # # ## ### ##### ######## ############# |
| 656 | } |
| 657 | |
| 658 | # # ## ### ##### ######## ############# ##################### |
| @@ -866,18 +674,230 @@ | |
| 674 | "] |
| 675 | } |
| 676 | |
| 677 | # var(dv) = dict (revision -> list (revision)) |
| 678 | typemethod internalsuccessors {dv revisions} { |
| 679 | upvar 1 $dv dependencies |
| 680 | set theset ('[join $revisions {','}]') |
| 681 | |
| 682 | # See 'successors' below for the main explanation of |
| 683 | # the various cases. This piece is special in that it |
| 684 | # restricts the successors we look for to the same set of |
| 685 | # revisions we start from. Sensible as we are looking for |
| 686 | # changeset internal dependencies. |
| 687 | |
| 688 | array set dep {} |
| 689 | |
| 690 | foreach {rid child} [state run " |
| 691 | -- (1) Primary child |
| 692 | SELECT R.rid, R.child |
| 693 | FROM revision R |
| 694 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 695 | AND R.child IS NOT NULL -- Has primary child |
| 696 | AND R.child IN $theset -- Which is also of interest |
| 697 | UNION |
| 698 | -- (2) Secondary (branch) children |
| 699 | SELECT R.rid, B.brid |
| 700 | FROM revision R, revisionbranchchildren B |
| 701 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 702 | AND R.rid = B.rid -- Select subset of branch children |
| 703 | AND B.brid IN $theset -- Which is also of interest |
| 704 | UNION |
| 705 | -- (4) Child of trunk root successor of last NTDB on trunk. |
| 706 | SELECT R.rid, RA.child |
| 707 | FROM revision R, revision RA |
| 708 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 709 | AND R.isdefault -- Restrict to NTDB |
| 710 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 711 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 712 | AND RA.child IS NOT NULL -- Has primary child. |
| 713 | AND RA.child IN $theset -- Which is also of interest |
| 714 | "] { |
| 715 | # Consider moving this to the integrity module. |
| 716 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 717 | lappend dependencies($rid) $child |
| 718 | set dep($rid,$child) . |
| 719 | } |
| 720 | |
| 721 | # The sql statements above looks only for direct dependencies |
| 722 | # between revision in the changeset. However due to the |
| 723 | # vagaries of meta data it is possible for two revisions of |
| 724 | # the same file to end up in the same changeset, without a |
| 725 | # direct dependency between them. However we know that there |
| 726 | # has to be a an indirect dependency, be it through primary |
| 727 | # children, branch children, or a combination thereof. |
| 728 | |
| 729 | # We now fill in these pseudo-dependencies, if no such |
| 730 | # dependency exists already. The direction of the dependency |
| 731 | # is actually irrelevant for this. |
| 732 | |
| 733 | # NOTE: This is different from cvs2svn. Our spiritual ancestor |
| 734 | # does not use such pseudo-dependencies, however it uses a |
| 735 | # COMMIT_THRESHOLD, a time interval commits should fall. This |
| 736 | # will greatly reduces the risk of getting far separated |
| 737 | # revisions of the same file into one changeset. |
| 738 | |
| 739 | # We allow revisions to be far apart in time in the same |
| 740 | # changeset, but need the pseudo-dependencies for this. |
| 741 | |
| 742 | array set fids {} |
| 743 | foreach {rid fid} [state run " |
| 744 | SELECT R.rid, R.fid FROM revision R WHERE R.rid IN $theset |
| 745 | "] { lappend fids($fid) $rid } |
| 746 | |
| 747 | foreach {fid rids} [array get fids] { |
| 748 | if {[llength $rids] < 2} continue |
| 749 | foreach a $rids { |
| 750 | foreach b $rids { |
| 751 | if {$a == $b} continue |
| 752 | if {[info exists dep($a,$b)]} continue |
| 753 | if {[info exists dep($b,$a)]} continue |
| 754 | lappend dependencies($a) $b |
| 755 | set dep($a,$b) . |
| 756 | set dep($b,$a) . |
| 757 | } |
| 758 | } |
| 759 | } |
| 760 | return |
| 761 | } |
| 762 | |
| 763 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 764 | typemethod successors {dv revisions} { |
| 765 | upvar 1 $dv dependencies |
| 766 | set theset ('[join $revisions {','}]') |
| 767 | |
| 768 | # The following cases specify when a revision S is a successor |
| 769 | # of a revision R. Each of the cases translates into one of |
| 770 | # the branches of the SQL UNION coming below. |
| 771 | # |
| 772 | # (1) S can be a primary child of R, i.e. in the same LOD. R |
| 773 | # references S directly. R.child = S(.rid), if it exists. |
| 774 | # |
| 775 | # (2) S can be a secondary, i.e. branch, child of R. Here the |
| 776 | # link is made through the helper table |
| 777 | # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = |
| 778 | # S(.rid) |
| 779 | # |
| 780 | # (3) Originally this use case defined the root of a detached |
| 781 | # NTDB as the successor of the trunk root. This leads to a |
| 782 | # bad tangle later on. With a detached NTDB the original |
| 783 | # trunk root revision was removed as irrelevant, allowing |
| 784 | # the nominal root to be later in time than the NTDB |
| 785 | # root. Now setting this dependency will be backward in |
| 786 | # time. REMOVED. |
| 787 | # |
| 788 | # (4) If R is the last of the NTDB revisions which belong to |
| 789 | # the trunk, then the primary child of the trunk root (the |
| 790 | # '1.2' revision) is a successor, if it exists. |
| 791 | |
| 792 | # Note that the branches spawned from the revisions, and the |
| 793 | # tags associated with them are successors as well. |
| 794 | |
| 795 | foreach {rid child} [state run " |
| 796 | -- (1) Primary child |
| 797 | SELECT R.rid, R.child |
| 798 | FROM revision R |
| 799 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 800 | AND R.child IS NOT NULL -- Has primary child |
| 801 | UNION |
| 802 | -- (2) Secondary (branch) children |
| 803 | SELECT R.rid, B.brid |
| 804 | FROM revision R, revisionbranchchildren B |
| 805 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 806 | AND R.rid = B.rid -- Select subset of branch children |
| 807 | UNION |
| 808 | -- (4) Child of trunk root successor of last NTDB on trunk. |
| 809 | SELECT R.rid, RA.child |
| 810 | FROM revision R, revision RA |
| 811 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 812 | AND R.isdefault -- Restrict to NTDB |
| 813 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 814 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 815 | AND RA.child IS NOT NULL -- Has primary child. |
| 816 | "] { |
| 817 | # Consider moving this to the integrity module. |
| 818 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 819 | lappend dependencies([list rev $rid]) [list rev $child] |
| 820 | } |
| 821 | foreach {rid child} [state run " |
| 822 | SELECT R.rid, T.tid |
| 823 | FROM revision R, tag T |
| 824 | WHERE R.rid in $theset |
| 825 | AND T.rev = R.rid |
| 826 | "] { |
| 827 | lappend dependencies([list rev $rid]) [list sym::tag $child] |
| 828 | } |
| 829 | foreach {rid child} [state run " |
| 830 | SELECT R.rid, B.bid |
| 831 | FROM revision R, branch B |
| 832 | WHERE R.rid in $theset |
| 833 | AND B.root = R.rid |
| 834 | "] { |
| 835 | lappend dependencies([list rev $rid]) [list sym::branch $child] |
| 836 | } |
| 837 | return |
| 838 | } |
| 839 | |
| 840 | # var(dv) = dict (item -> list (item)), item = list (type id) |
| 841 | typemethod predecessors {dv revisions} { |
| 842 | upvar 1 $dv dependencies |
| 843 | set theset ('[join $revisions {','}]') |
| 844 | |
| 845 | # The following cases specify when a revision P is a |
| 846 | # predecessor of a revision R. Each of the cases translates |
| 847 | # into one of the branches of the SQL UNION coming below. |
| 848 | # |
| 849 | # (1) The immediate parent R.parent of R is a predecessor of |
| 850 | # R. NOTE: This is true for R either primary or secondary |
| 851 | # child of P. It not necessary to distinguish the two |
| 852 | # cases, in contrast to the code retrieving the successor |
| 853 | # information. |
| 854 | # |
| 855 | # (2) The complement of successor case (3). The trunk root is |
| 856 | # a predecessor of a NTDB root. REMOVED. See 'successors' |
| 857 | # for the explanation. |
| 858 | # |
| 859 | # (3) The complement of successor case (4). The last NTDB |
| 860 | # revision belonging to the trunk is a predecessor of the |
| 861 | # primary child of the trunk root (The '1.2' revision). |
| 862 | |
| 863 | foreach {rid parent} [state run " |
| 864 | -- (1) Primary parent, can be in different LOD for first in a branch |
| 865 | SELECT R.rid, R.parent |
| 866 | FROM revision R |
| 867 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 868 | AND R.parent IS NOT NULL -- Has primary parent |
| 869 | UNION |
| 870 | -- (3) Last NTDB on trunk is predecessor of child of trunk root |
| 871 | SELECT R.rid, RA.dbparent |
| 872 | FROM revision R, revision RA |
| 873 | WHERE R.rid IN $theset -- Restrict to revisions of interest |
| 874 | AND NOT R.isdefault -- not on NTDB |
| 875 | AND R.parent IS NOT NULL -- which are not root |
| 876 | AND RA.rid = R.parent -- go to their parent |
| 877 | AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root |
| 878 | "] { |
| 879 | # Consider moving this to the integrity module. |
| 880 | integrity assert {$rid != $parent} {Revision $rid depends on itself.} |
| 881 | lappend dependencies([list rev $rid]) [list rev $parent] |
| 882 | } |
| 883 | |
| 884 | # The revisions which are the first on a branch have that |
| 885 | # branch as their predecessor. Note that revisions cannot be |
| 886 | # on tags in the same manner, so tags cannot be predecessors |
| 887 | # of revisions. This complements that they have no successors |
| 888 | # (See sym::tag/successors). |
| 889 | |
| 890 | foreach {rid parent} [state run " |
| 891 | SELECT R.rid B.bid |
| 892 | FROM revision R, branch B |
| 893 | WHERE R.rid IN $theset |
| 894 | AND B.first = R.rid |
| 895 | "] { |
| 896 | lappend dependencies([list rev $rid]) [list sym::branch $parent] |
| 897 | } |
| 898 | return |
| 899 | } |
| 900 | } |
| 901 | |
| 902 | # # ## ### ##### ######## ############# ##################### |
| 903 | ## Helper singleton. Commands for tag symbol changesets. |
| @@ -936,14 +956,10 @@ | |
| 956 | namespace eval ::vc::fossil::import::cvs::project { |
| 957 | namespace export rev |
| 958 | namespace eval rev { |
| 959 | namespace import ::vc::fossil::import::cvs::state |
| 960 | namespace import ::vc::fossil::import::cvs::integrity |
| 961 | namespace import ::vc::tools::misc::* |
| 962 | namespace import ::vc::tools::trouble |
| 963 | namespace import ::vc::tools::log |
| 964 | log register csets |
| 965 | |
| 966 |