Fossil SCM
Added convenience method for assertions and used it in place of the existing if/trouble internal constructions. Changed API of 'log write' so that we can defer substituation of the message to when the write actually happen, and converted all places which would be hit by double-substitution. The remaining 'log write' calls will be converted incrementally.
Commit
47d52d1efd967e4ee4f1159b822c175eefe96233
Parent
6b520e7d97c3d61…
12 files changed
+11
-11
+5
-3
+6
-4
+10
-3
+12
-10
+9
-10
+2
-2
+18
-30
+3
-3
+1
-1
+1
-1
+2
-1
~
tools/cvs2fossil/lib/c2f_file.tcl
~
tools/cvs2fossil/lib/c2f_frev.tcl
~
tools/cvs2fossil/lib/c2f_fsym.tcl
~
tools/cvs2fossil/lib/c2f_integrity.tcl
~
tools/cvs2fossil/lib/c2f_pass.tcl
~
tools/cvs2fossil/lib/c2f_pbreakacycle.tcl
~
tools/cvs2fossil/lib/c2f_pfiltersym.tcl
~
tools/cvs2fossil/lib/c2f_prev.tcl
~
tools/cvs2fossil/lib/c2f_prevlink.tcl
~
tools/cvs2fossil/lib/c2f_psym.tcl
~
tools/cvs2fossil/lib/c2f_state.tcl
~
tools/cvs2fossil/lib/log.tcl
+11
-11
| --- tools/cvs2fossil/lib/c2f_file.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_file.tcl | ||
| @@ -20,10 +20,11 @@ | ||
| 20 | 20 | package require snit ; # OO system. |
| 21 | 21 | package require struct::set ; # Set operations. |
| 22 | 22 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 23 | 23 | package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols. |
| 24 | 24 | package require vc::fossil::import::cvs::state ; # State storage. |
| 25 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 25 | 26 | package require vc::tools::trouble ; # Error reporting. |
| 26 | 27 | package require vc::tools::log ; # User feedback |
| 27 | 28 | package require vc::tools::misc ; # Text formatting |
| 28 | 29 | |
| 29 | 30 | # # ## ### ##### ######## ############# ##################### |
| @@ -42,11 +43,11 @@ | ||
| 42 | 43 | set mytrunk [$myproject trunk] |
| 43 | 44 | return |
| 44 | 45 | } |
| 45 | 46 | |
| 46 | 47 | method setid {id} { |
| 47 | - if {$myid ne ""} { trouble internal "File '$mypath' already has an id, '$myid'" } | |
| 48 | + integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'} | |
| 48 | 49 | set myid $id |
| 49 | 50 | return |
| 50 | 51 | } |
| 51 | 52 | |
| 52 | 53 | method id {} { return $myid } |
| @@ -325,13 +326,11 @@ | ||
| 325 | 326 | } |
| 326 | 327 | return |
| 327 | 328 | } |
| 328 | 329 | |
| 329 | 330 | method Rev2Branch {revnr} { |
| 330 | - if {[rev istrunkrevnr $revnr]} { | |
| 331 | - trouble internal "Expected a branch revision number" | |
| 332 | - } | |
| 331 | + integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number} | |
| 333 | 332 | return $mybranches([rev 2branchnr $revnr]) |
| 334 | 333 | } |
| 335 | 334 | |
| 336 | 335 | method AddUnlabeledBranch {branchnr} { |
| 337 | 336 | return [$self AddBranch unlabeled-$branchnr $branchnr] |
| @@ -461,11 +460,11 @@ | ||
| 461 | 460 | # simply take one revision and follow the parent links to |
| 462 | 461 | # their root (sic!). |
| 463 | 462 | |
| 464 | 463 | foreach {revnr rev} [array get myrev] { |
| 465 | 464 | if {[$rev hasparent]} continue |
| 466 | - if {$myroot ne ""} { trouble internal "Multiple root revisions found" } | |
| 465 | + integrity assert {$myroot eq ""} {Multiple root revisions found} | |
| 467 | 466 | set myroot $rev |
| 468 | 467 | } |
| 469 | 468 | |
| 470 | 469 | # In the future we also need a list, as branches can become |
| 471 | 470 | # severed from their parent, making them their own root. |
| @@ -699,11 +698,11 @@ | ||
| 699 | 698 | } |
| 700 | 699 | |
| 701 | 700 | # Cut out the vendor branch symbol |
| 702 | 701 | |
| 703 | 702 | set vendor [$first parentbranch] |
| 704 | - if {$vendor eq ""} { trouble internal "First NTDB revision has no branch" } | |
| 703 | + integrity assert {$vendor ne ""} {First NTDB revision has no branch} | |
| 705 | 704 | if {[$vendor parent] eq $rev11} { |
| 706 | 705 | $rev11 removebranch $vendor |
| 707 | 706 | $rev11 removechildonbranch $first |
| 708 | 707 | $vendor cutchild |
| 709 | 708 | $first cutfromparentbranch |
| @@ -954,13 +953,13 @@ | ||
| 954 | 953 | # should therefore not just be discarded even if |
| 955 | 954 | # --trunk-only. |
| 956 | 955 | |
| 957 | 956 | if {[$root hasdefaultbranchchild]} { |
| 958 | 957 | set ntdbchild [$root defaultbranchchild] |
| 959 | - if {[$ntdbchild defaultbranchparent] ne $ntdbchild} { | |
| 960 | - trouble internal "ntdb - trunk linkage broken" | |
| 961 | - } | |
| 958 | + integrity assert { | |
| 959 | + [$ntdbchild defaultbranchparent] eq $ntdbchild | |
| 960 | + } {ntdb - trunk linkage broken} | |
| 962 | 961 | $ntdbchild cutdefaultbranchparent |
| 963 | 962 | if {[$ntdbchild hasparent]} { |
| 964 | 963 | lappend myroots [$ntdbchild parent] |
| 965 | 964 | } |
| 966 | 965 | } |
| @@ -974,12 +973,12 @@ | ||
| 974 | 973 | method GraftNTDB2Trunk {root} { |
| 975 | 974 | # We can now graft the non-trunk default branch revisions to |
| 976 | 975 | # trunk. They should already be alone on a CVSBranch-less |
| 977 | 976 | # branch. |
| 978 | 977 | |
| 979 | - if {[$root hasparentbranch]} { trouble internal "NTDB root still has its branch symbol" } | |
| 980 | - if {[$root hasbranches]} { trouble internal "NTDB root still has spawned branches" } | |
| 978 | + integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol} | |
| 979 | + integrity assert {![$root hasbranches]} {NTDB root still has spawned branches} | |
| 981 | 980 | |
| 982 | 981 | set last $root |
| 983 | 982 | while {[$last haschild]} {set last [$last child]} |
| 984 | 983 | |
| 985 | 984 | if {[$last hasdefaultbranchchild]} { |
| @@ -1107,13 +1106,14 @@ | ||
| 1107 | 1106 | # namespace import ::vc::fossil::import::cvs::file::sym |
| 1108 | 1107 | namespace import ::vc::tools::misc::* |
| 1109 | 1108 | namespace import ::vc::tools::trouble |
| 1110 | 1109 | namespace import ::vc::tools::log |
| 1111 | 1110 | namespace import ::vc::fossil::import::cvs::state |
| 1111 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 1112 | 1112 | } |
| 1113 | 1113 | } |
| 1114 | 1114 | |
| 1115 | 1115 | # # ## ### ##### ######## ############# ##################### |
| 1116 | 1116 | ## Ready |
| 1117 | 1117 | |
| 1118 | 1118 | package provide vc::fossil::import::cvs::file 1.0 |
| 1119 | 1119 | return |
| 1120 | 1120 |
| --- tools/cvs2fossil/lib/c2f_file.tcl | |
| +++ tools/cvs2fossil/lib/c2f_file.tcl | |
| @@ -20,10 +20,11 @@ | |
| 20 | package require snit ; # OO system. |
| 21 | package require struct::set ; # Set operations. |
| 22 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 23 | package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols. |
| 24 | package require vc::fossil::import::cvs::state ; # State storage. |
| 25 | package require vc::tools::trouble ; # Error reporting. |
| 26 | package require vc::tools::log ; # User feedback |
| 27 | package require vc::tools::misc ; # Text formatting |
| 28 | |
| 29 | # # ## ### ##### ######## ############# ##################### |
| @@ -42,11 +43,11 @@ | |
| 42 | set mytrunk [$myproject trunk] |
| 43 | return |
| 44 | } |
| 45 | |
| 46 | method setid {id} { |
| 47 | if {$myid ne ""} { trouble internal "File '$mypath' already has an id, '$myid'" } |
| 48 | set myid $id |
| 49 | return |
| 50 | } |
| 51 | |
| 52 | method id {} { return $myid } |
| @@ -325,13 +326,11 @@ | |
| 325 | } |
| 326 | return |
| 327 | } |
| 328 | |
| 329 | method Rev2Branch {revnr} { |
| 330 | if {[rev istrunkrevnr $revnr]} { |
| 331 | trouble internal "Expected a branch revision number" |
| 332 | } |
| 333 | return $mybranches([rev 2branchnr $revnr]) |
| 334 | } |
| 335 | |
| 336 | method AddUnlabeledBranch {branchnr} { |
| 337 | return [$self AddBranch unlabeled-$branchnr $branchnr] |
| @@ -461,11 +460,11 @@ | |
| 461 | # simply take one revision and follow the parent links to |
| 462 | # their root (sic!). |
| 463 | |
| 464 | foreach {revnr rev} [array get myrev] { |
| 465 | if {[$rev hasparent]} continue |
| 466 | if {$myroot ne ""} { trouble internal "Multiple root revisions found" } |
| 467 | set myroot $rev |
| 468 | } |
| 469 | |
| 470 | # In the future we also need a list, as branches can become |
| 471 | # severed from their parent, making them their own root. |
| @@ -699,11 +698,11 @@ | |
| 699 | } |
| 700 | |
| 701 | # Cut out the vendor branch symbol |
| 702 | |
| 703 | set vendor [$first parentbranch] |
| 704 | if {$vendor eq ""} { trouble internal "First NTDB revision has no branch" } |
| 705 | if {[$vendor parent] eq $rev11} { |
| 706 | $rev11 removebranch $vendor |
| 707 | $rev11 removechildonbranch $first |
| 708 | $vendor cutchild |
| 709 | $first cutfromparentbranch |
| @@ -954,13 +953,13 @@ | |
| 954 | # should therefore not just be discarded even if |
| 955 | # --trunk-only. |
| 956 | |
| 957 | if {[$root hasdefaultbranchchild]} { |
| 958 | set ntdbchild [$root defaultbranchchild] |
| 959 | if {[$ntdbchild defaultbranchparent] ne $ntdbchild} { |
| 960 | trouble internal "ntdb - trunk linkage broken" |
| 961 | } |
| 962 | $ntdbchild cutdefaultbranchparent |
| 963 | if {[$ntdbchild hasparent]} { |
| 964 | lappend myroots [$ntdbchild parent] |
| 965 | } |
| 966 | } |
| @@ -974,12 +973,12 @@ | |
| 974 | method GraftNTDB2Trunk {root} { |
| 975 | # We can now graft the non-trunk default branch revisions to |
| 976 | # trunk. They should already be alone on a CVSBranch-less |
| 977 | # branch. |
| 978 | |
| 979 | if {[$root hasparentbranch]} { trouble internal "NTDB root still has its branch symbol" } |
| 980 | if {[$root hasbranches]} { trouble internal "NTDB root still has spawned branches" } |
| 981 | |
| 982 | set last $root |
| 983 | while {[$last haschild]} {set last [$last child]} |
| 984 | |
| 985 | if {[$last hasdefaultbranchchild]} { |
| @@ -1107,13 +1106,14 @@ | |
| 1107 | # namespace import ::vc::fossil::import::cvs::file::sym |
| 1108 | namespace import ::vc::tools::misc::* |
| 1109 | namespace import ::vc::tools::trouble |
| 1110 | namespace import ::vc::tools::log |
| 1111 | namespace import ::vc::fossil::import::cvs::state |
| 1112 | } |
| 1113 | } |
| 1114 | |
| 1115 | # # ## ### ##### ######## ############# ##################### |
| 1116 | ## Ready |
| 1117 | |
| 1118 | package provide vc::fossil::import::cvs::file 1.0 |
| 1119 | return |
| 1120 |
| --- tools/cvs2fossil/lib/c2f_file.tcl | |
| +++ tools/cvs2fossil/lib/c2f_file.tcl | |
| @@ -20,10 +20,11 @@ | |
| 20 | package require snit ; # OO system. |
| 21 | package require struct::set ; # Set operations. |
| 22 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 23 | package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols. |
| 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::tools::trouble ; # Error reporting. |
| 27 | package require vc::tools::log ; # User feedback |
| 28 | package require vc::tools::misc ; # Text formatting |
| 29 | |
| 30 | # # ## ### ##### ######## ############# ##################### |
| @@ -42,11 +43,11 @@ | |
| 43 | set mytrunk [$myproject trunk] |
| 44 | return |
| 45 | } |
| 46 | |
| 47 | method setid {id} { |
| 48 | integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'} |
| 49 | set myid $id |
| 50 | return |
| 51 | } |
| 52 | |
| 53 | method id {} { return $myid } |
| @@ -325,13 +326,11 @@ | |
| 326 | } |
| 327 | return |
| 328 | } |
| 329 | |
| 330 | method Rev2Branch {revnr} { |
| 331 | integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number} |
| 332 | return $mybranches([rev 2branchnr $revnr]) |
| 333 | } |
| 334 | |
| 335 | method AddUnlabeledBranch {branchnr} { |
| 336 | return [$self AddBranch unlabeled-$branchnr $branchnr] |
| @@ -461,11 +460,11 @@ | |
| 460 | # simply take one revision and follow the parent links to |
| 461 | # their root (sic!). |
| 462 | |
| 463 | foreach {revnr rev} [array get myrev] { |
| 464 | if {[$rev hasparent]} continue |
| 465 | integrity assert {$myroot eq ""} {Multiple root revisions found} |
| 466 | set myroot $rev |
| 467 | } |
| 468 | |
| 469 | # In the future we also need a list, as branches can become |
| 470 | # severed from their parent, making them their own root. |
| @@ -699,11 +698,11 @@ | |
| 698 | } |
| 699 | |
| 700 | # Cut out the vendor branch symbol |
| 701 | |
| 702 | set vendor [$first parentbranch] |
| 703 | integrity assert {$vendor ne ""} {First NTDB revision has no branch} |
| 704 | if {[$vendor parent] eq $rev11} { |
| 705 | $rev11 removebranch $vendor |
| 706 | $rev11 removechildonbranch $first |
| 707 | $vendor cutchild |
| 708 | $first cutfromparentbranch |
| @@ -954,13 +953,13 @@ | |
| 953 | # should therefore not just be discarded even if |
| 954 | # --trunk-only. |
| 955 | |
| 956 | if {[$root hasdefaultbranchchild]} { |
| 957 | set ntdbchild [$root defaultbranchchild] |
| 958 | integrity assert { |
| 959 | [$ntdbchild defaultbranchparent] eq $ntdbchild |
| 960 | } {ntdb - trunk linkage broken} |
| 961 | $ntdbchild cutdefaultbranchparent |
| 962 | if {[$ntdbchild hasparent]} { |
| 963 | lappend myroots [$ntdbchild parent] |
| 964 | } |
| 965 | } |
| @@ -974,12 +973,12 @@ | |
| 973 | method GraftNTDB2Trunk {root} { |
| 974 | # We can now graft the non-trunk default branch revisions to |
| 975 | # trunk. They should already be alone on a CVSBranch-less |
| 976 | # branch. |
| 977 | |
| 978 | integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol} |
| 979 | integrity assert {![$root hasbranches]} {NTDB root still has spawned branches} |
| 980 | |
| 981 | set last $root |
| 982 | while {[$last haschild]} {set last [$last child]} |
| 983 | |
| 984 | if {[$last hasdefaultbranchchild]} { |
| @@ -1107,13 +1106,14 @@ | |
| 1106 | # namespace import ::vc::fossil::import::cvs::file::sym |
| 1107 | namespace import ::vc::tools::misc::* |
| 1108 | namespace import ::vc::tools::trouble |
| 1109 | namespace import ::vc::tools::log |
| 1110 | namespace import ::vc::fossil::import::cvs::state |
| 1111 | namespace import ::vc::fossil::import::cvs::integrity |
| 1112 | } |
| 1113 | } |
| 1114 | |
| 1115 | # # ## ### ##### ######## ############# ##################### |
| 1116 | ## Ready |
| 1117 | |
| 1118 | package provide vc::fossil::import::cvs::file 1.0 |
| 1119 | return |
| 1120 |
| --- tools/cvs2fossil/lib/c2f_frev.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_frev.tcl | ||
| @@ -17,10 +17,11 @@ | ||
| 17 | 17 | |
| 18 | 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | 19 | package require snit ; # OO system. |
| 20 | 20 | package require vc::tools::misc ; # Text formatting |
| 21 | 21 | package require vc::fossil::import::cvs::state ; # State storage. |
| 22 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 22 | 23 | |
| 23 | 24 | # # ## ### ##### ######## ############# ##################### |
| 24 | 25 | ## |
| 25 | 26 | |
| 26 | 27 | snit::type ::vc::fossil::import::cvs::file::rev { |
| @@ -119,20 +120,20 @@ | ||
| 119 | 120 | |
| 120 | 121 | method hasparent {} { return [expr {$myparent ne ""}] } |
| 121 | 122 | method haschild {} { return [expr {$mychild ne ""}] } |
| 122 | 123 | |
| 123 | 124 | method setparent {parent} { |
| 124 | - if {$myparent ne ""} { trouble internal "Parent already defined" } | |
| 125 | + integrity assert {$myparent eq ""} {Parent already defined} | |
| 125 | 126 | set myparent $parent |
| 126 | 127 | return |
| 127 | 128 | } |
| 128 | 129 | |
| 129 | 130 | method cutfromparent {} { set myparent "" ; return } |
| 130 | 131 | method cutfromchild {} { set mychild "" ; return } |
| 131 | 132 | |
| 132 | 133 | method setchild {child} { |
| 133 | - if {$mychild ne ""} { trouble internal "Child already defined" } | |
| 134 | + integrity assert {$mychild eq ""} {Child already defined} | |
| 134 | 135 | set mychild $child |
| 135 | 136 | return |
| 136 | 137 | } |
| 137 | 138 | |
| 138 | 139 | method changeparent {parent} { set myparent $parent ; return } |
| @@ -142,11 +143,11 @@ | ||
| 142 | 143 | method child {} { return $mychild } |
| 143 | 144 | |
| 144 | 145 | # Branch linkage ______________________ |
| 145 | 146 | |
| 146 | 147 | method setparentbranch {branch} { |
| 147 | - if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" } | |
| 148 | + integrity assert {$myparentbranch eq ""} {Branch parent already defined} | |
| 148 | 149 | set myparentbranch $branch |
| 149 | 150 | return |
| 150 | 151 | } |
| 151 | 152 | |
| 152 | 153 | method hasparentbranch {} { return [expr {$myparentbranch ne ""}] } |
| @@ -519,13 +520,14 @@ | ||
| 519 | 520 | namespace eval ::vc::fossil::import::cvs::file { |
| 520 | 521 | namespace export rev |
| 521 | 522 | namespace eval rev { |
| 522 | 523 | namespace import ::vc::tools::misc::* |
| 523 | 524 | namespace import ::vc::fossil::import::cvs::state |
| 525 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 524 | 526 | } |
| 525 | 527 | } |
| 526 | 528 | |
| 527 | 529 | # # ## ### ##### ######## ############# ##################### |
| 528 | 530 | ## Ready |
| 529 | 531 | |
| 530 | 532 | package provide vc::fossil::import::cvs::file::rev 1.0 |
| 531 | 533 | return |
| 532 | 534 |
| --- tools/cvs2fossil/lib/c2f_frev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_frev.tcl | |
| @@ -17,10 +17,11 @@ | |
| 17 | |
| 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | package require snit ; # OO system. |
| 20 | package require vc::tools::misc ; # Text formatting |
| 21 | package require vc::fossil::import::cvs::state ; # State storage. |
| 22 | |
| 23 | # # ## ### ##### ######## ############# ##################### |
| 24 | ## |
| 25 | |
| 26 | snit::type ::vc::fossil::import::cvs::file::rev { |
| @@ -119,20 +120,20 @@ | |
| 119 | |
| 120 | method hasparent {} { return [expr {$myparent ne ""}] } |
| 121 | method haschild {} { return [expr {$mychild ne ""}] } |
| 122 | |
| 123 | method setparent {parent} { |
| 124 | if {$myparent ne ""} { trouble internal "Parent already defined" } |
| 125 | set myparent $parent |
| 126 | return |
| 127 | } |
| 128 | |
| 129 | method cutfromparent {} { set myparent "" ; return } |
| 130 | method cutfromchild {} { set mychild "" ; return } |
| 131 | |
| 132 | method setchild {child} { |
| 133 | if {$mychild ne ""} { trouble internal "Child already defined" } |
| 134 | set mychild $child |
| 135 | return |
| 136 | } |
| 137 | |
| 138 | method changeparent {parent} { set myparent $parent ; return } |
| @@ -142,11 +143,11 @@ | |
| 142 | method child {} { return $mychild } |
| 143 | |
| 144 | # Branch linkage ______________________ |
| 145 | |
| 146 | method setparentbranch {branch} { |
| 147 | if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" } |
| 148 | set myparentbranch $branch |
| 149 | return |
| 150 | } |
| 151 | |
| 152 | method hasparentbranch {} { return [expr {$myparentbranch ne ""}] } |
| @@ -519,13 +520,14 @@ | |
| 519 | namespace eval ::vc::fossil::import::cvs::file { |
| 520 | namespace export rev |
| 521 | namespace eval rev { |
| 522 | namespace import ::vc::tools::misc::* |
| 523 | namespace import ::vc::fossil::import::cvs::state |
| 524 | } |
| 525 | } |
| 526 | |
| 527 | # # ## ### ##### ######## ############# ##################### |
| 528 | ## Ready |
| 529 | |
| 530 | package provide vc::fossil::import::cvs::file::rev 1.0 |
| 531 | return |
| 532 |
| --- tools/cvs2fossil/lib/c2f_frev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_frev.tcl | |
| @@ -17,10 +17,11 @@ | |
| 17 | |
| 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | package require snit ; # OO system. |
| 20 | package require vc::tools::misc ; # Text formatting |
| 21 | package require vc::fossil::import::cvs::state ; # State storage. |
| 22 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 23 | |
| 24 | # # ## ### ##### ######## ############# ##################### |
| 25 | ## |
| 26 | |
| 27 | snit::type ::vc::fossil::import::cvs::file::rev { |
| @@ -119,20 +120,20 @@ | |
| 120 | |
| 121 | method hasparent {} { return [expr {$myparent ne ""}] } |
| 122 | method haschild {} { return [expr {$mychild ne ""}] } |
| 123 | |
| 124 | method setparent {parent} { |
| 125 | integrity assert {$myparent eq ""} {Parent already defined} |
| 126 | set myparent $parent |
| 127 | return |
| 128 | } |
| 129 | |
| 130 | method cutfromparent {} { set myparent "" ; return } |
| 131 | method cutfromchild {} { set mychild "" ; return } |
| 132 | |
| 133 | method setchild {child} { |
| 134 | integrity assert {$mychild eq ""} {Child already defined} |
| 135 | set mychild $child |
| 136 | return |
| 137 | } |
| 138 | |
| 139 | method changeparent {parent} { set myparent $parent ; return } |
| @@ -142,11 +143,11 @@ | |
| 143 | method child {} { return $mychild } |
| 144 | |
| 145 | # Branch linkage ______________________ |
| 146 | |
| 147 | method setparentbranch {branch} { |
| 148 | integrity assert {$myparentbranch eq ""} {Branch parent already defined} |
| 149 | set myparentbranch $branch |
| 150 | return |
| 151 | } |
| 152 | |
| 153 | method hasparentbranch {} { return [expr {$myparentbranch ne ""}] } |
| @@ -519,13 +520,14 @@ | |
| 520 | namespace eval ::vc::fossil::import::cvs::file { |
| 521 | namespace export rev |
| 522 | namespace eval rev { |
| 523 | namespace import ::vc::tools::misc::* |
| 524 | namespace import ::vc::fossil::import::cvs::state |
| 525 | namespace import ::vc::fossil::import::cvs::integrity |
| 526 | } |
| 527 | } |
| 528 | |
| 529 | # # ## ### ##### ######## ############# ##################### |
| 530 | ## Ready |
| 531 | |
| 532 | package provide vc::fossil::import::cvs::file::rev 1.0 |
| 533 | return |
| 534 |
| --- tools/cvs2fossil/lib/c2f_fsym.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_fsym.tcl | ||
| @@ -18,10 +18,11 @@ | ||
| 18 | 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | 19 | package require snit ; # OO system. |
| 20 | 20 | package require vc::tools::trouble ; # Error reporting. |
| 21 | 21 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 22 | 22 | package require vc::fossil::import::cvs::state ; # State storage. |
| 23 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 23 | 24 | |
| 24 | 25 | # # ## ### ##### ######## ############# ##################### |
| 25 | 26 | ## |
| 26 | 27 | |
| 27 | 28 | snit::type ::vc::fossil::import::cvs::file::sym { |
| @@ -33,14 +34,14 @@ | ||
| 33 | 34 | set mytype $symtype |
| 34 | 35 | set mynr $nr |
| 35 | 36 | set mysymbol $symbol |
| 36 | 37 | |
| 37 | 38 | switch -exact -- $mytype { |
| 38 | - branch { SetupBranch } | |
| 39 | - tag { } | |
| 40 | - default { trouble internal "Bad symbol type '$mytype'" } | |
| 39 | + branch { SetupBranch ; return } | |
| 40 | + tag { return } | |
| 41 | 41 | } |
| 42 | + integrity assert 0 {Bad symbol type '$mytype'} | |
| 42 | 43 | return |
| 43 | 44 | } |
| 44 | 45 | |
| 45 | 46 | method defid {} { |
| 46 | 47 | set myid [incr myidcounter] |
| @@ -113,11 +114,11 @@ | ||
| 113 | 114 | method istrunk {} { return 0 } |
| 114 | 115 | |
| 115 | 116 | # Branch acessor methods. |
| 116 | 117 | |
| 117 | 118 | method setchildrevnr {revnr} { |
| 118 | - if {$mybranchchildrevnr ne ""} { trouble internal "Child already defined" } | |
| 119 | + integrity assert {$mybranchchildrevnr eq ""} {Child already defined} | |
| 119 | 120 | set mybranchchildrevnr $revnr |
| 120 | 121 | return |
| 121 | 122 | } |
| 122 | 123 | |
| 123 | 124 | method setposition {n} { set mybranchposition $n ; return } |
| @@ -284,14 +285,15 @@ | ||
| 284 | 285 | namespace eval ::vc::fossil::import::cvs::file { |
| 285 | 286 | namespace export sym |
| 286 | 287 | namespace eval sym { |
| 287 | 288 | namespace import ::vc::fossil::import::cvs::file::rev |
| 288 | 289 | namespace import ::vc::fossil::import::cvs::state |
| 290 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 289 | 291 | namespace import ::vc::tools::trouble |
| 290 | 292 | } |
| 291 | 293 | } |
| 292 | 294 | |
| 293 | 295 | # # ## ### ##### ######## ############# ##################### |
| 294 | 296 | ## Ready |
| 295 | 297 | |
| 296 | 298 | package provide vc::fossil::import::cvs::file::sym 1.0 |
| 297 | 299 | return |
| 298 | 300 |
| --- tools/cvs2fossil/lib/c2f_fsym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_fsym.tcl | |
| @@ -18,10 +18,11 @@ | |
| 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | package require snit ; # OO system. |
| 20 | package require vc::tools::trouble ; # Error reporting. |
| 21 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 22 | package require vc::fossil::import::cvs::state ; # State storage. |
| 23 | |
| 24 | # # ## ### ##### ######## ############# ##################### |
| 25 | ## |
| 26 | |
| 27 | snit::type ::vc::fossil::import::cvs::file::sym { |
| @@ -33,14 +34,14 @@ | |
| 33 | set mytype $symtype |
| 34 | set mynr $nr |
| 35 | set mysymbol $symbol |
| 36 | |
| 37 | switch -exact -- $mytype { |
| 38 | branch { SetupBranch } |
| 39 | tag { } |
| 40 | default { trouble internal "Bad symbol type '$mytype'" } |
| 41 | } |
| 42 | return |
| 43 | } |
| 44 | |
| 45 | method defid {} { |
| 46 | set myid [incr myidcounter] |
| @@ -113,11 +114,11 @@ | |
| 113 | method istrunk {} { return 0 } |
| 114 | |
| 115 | # Branch acessor methods. |
| 116 | |
| 117 | method setchildrevnr {revnr} { |
| 118 | if {$mybranchchildrevnr ne ""} { trouble internal "Child already defined" } |
| 119 | set mybranchchildrevnr $revnr |
| 120 | return |
| 121 | } |
| 122 | |
| 123 | method setposition {n} { set mybranchposition $n ; return } |
| @@ -284,14 +285,15 @@ | |
| 284 | namespace eval ::vc::fossil::import::cvs::file { |
| 285 | namespace export sym |
| 286 | namespace eval sym { |
| 287 | namespace import ::vc::fossil::import::cvs::file::rev |
| 288 | namespace import ::vc::fossil::import::cvs::state |
| 289 | namespace import ::vc::tools::trouble |
| 290 | } |
| 291 | } |
| 292 | |
| 293 | # # ## ### ##### ######## ############# ##################### |
| 294 | ## Ready |
| 295 | |
| 296 | package provide vc::fossil::import::cvs::file::sym 1.0 |
| 297 | return |
| 298 |
| --- tools/cvs2fossil/lib/c2f_fsym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_fsym.tcl | |
| @@ -18,10 +18,11 @@ | |
| 18 | package require Tcl 8.4 ; # Required runtime. |
| 19 | package require snit ; # OO system. |
| 20 | package require vc::tools::trouble ; # Error reporting. |
| 21 | package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
| 22 | package require vc::fossil::import::cvs::state ; # State storage. |
| 23 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 24 | |
| 25 | # # ## ### ##### ######## ############# ##################### |
| 26 | ## |
| 27 | |
| 28 | snit::type ::vc::fossil::import::cvs::file::sym { |
| @@ -33,14 +34,14 @@ | |
| 34 | set mytype $symtype |
| 35 | set mynr $nr |
| 36 | set mysymbol $symbol |
| 37 | |
| 38 | switch -exact -- $mytype { |
| 39 | branch { SetupBranch ; return } |
| 40 | tag { return } |
| 41 | } |
| 42 | integrity assert 0 {Bad symbol type '$mytype'} |
| 43 | return |
| 44 | } |
| 45 | |
| 46 | method defid {} { |
| 47 | set myid [incr myidcounter] |
| @@ -113,11 +114,11 @@ | |
| 114 | method istrunk {} { return 0 } |
| 115 | |
| 116 | # Branch acessor methods. |
| 117 | |
| 118 | method setchildrevnr {revnr} { |
| 119 | integrity assert {$mybranchchildrevnr eq ""} {Child already defined} |
| 120 | set mybranchchildrevnr $revnr |
| 121 | return |
| 122 | } |
| 123 | |
| 124 | method setposition {n} { set mybranchposition $n ; return } |
| @@ -284,14 +285,15 @@ | |
| 285 | namespace eval ::vc::fossil::import::cvs::file { |
| 286 | namespace export sym |
| 287 | namespace eval sym { |
| 288 | namespace import ::vc::fossil::import::cvs::file::rev |
| 289 | namespace import ::vc::fossil::import::cvs::state |
| 290 | namespace import ::vc::fossil::import::cvs::integrity |
| 291 | namespace import ::vc::tools::trouble |
| 292 | } |
| 293 | } |
| 294 | |
| 295 | # # ## ### ##### ######## ############# ##################### |
| 296 | ## Ready |
| 297 | |
| 298 | package provide vc::fossil::import::cvs::file::sym 1.0 |
| 299 | return |
| 300 |
| --- tools/cvs2fossil/lib/c2f_integrity.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_integrity.tcl | ||
| @@ -26,10 +26,17 @@ | ||
| 26 | 26 | ## |
| 27 | 27 | |
| 28 | 28 | snit::type ::vc::fossil::import::cvs::integrity { |
| 29 | 29 | # # ## ### ##### ######## ############# |
| 30 | 30 | ## Public API |
| 31 | + | |
| 32 | + typemethod assert {expression failmessage} { | |
| 33 | + set ok [uplevel 1 [list ::expr $expression]] | |
| 34 | + if {$ok} return | |
| 35 | + trouble internal [uplevel 1 [list ::subst $failmessage]] | |
| 36 | + return | |
| 37 | + } | |
| 31 | 38 | |
| 32 | 39 | typemethod strict {} { |
| 33 | 40 | log write 4 integrity {Check database consistency} |
| 34 | 41 | |
| 35 | 42 | set n 0 |
| @@ -515,11 +522,11 @@ | ||
| 515 | 522 | set ok 1 |
| 516 | 523 | foreach {fname revnr} [state run $sql] { |
| 517 | 524 | set ok 0 |
| 518 | 525 | trouble fatal "$fname <$revnr> $label" |
| 519 | 526 | } |
| 520 | - log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" | |
| 527 | + log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} | |
| 521 | 528 | return |
| 522 | 529 | } |
| 523 | 530 | |
| 524 | 531 | proc CheckCS {header label sql} { |
| 525 | 532 | upvar 1 n n |
| @@ -526,11 +533,11 @@ | ||
| 526 | 533 | set ok 1 |
| 527 | 534 | foreach {ctype cid} [state run $sql] { |
| 528 | 535 | set ok 0 |
| 529 | 536 | trouble fatal "<$ctype $cid> $label" |
| 530 | 537 | } |
| 531 | - log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" | |
| 538 | + log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} | |
| 532 | 539 | return |
| 533 | 540 | } |
| 534 | 541 | |
| 535 | 542 | proc CheckInCS {header label sql} { |
| 536 | 543 | upvar 1 n n |
| @@ -538,11 +545,11 @@ | ||
| 538 | 545 | foreach {cstype csid fname revnr} [state run $sql] { |
| 539 | 546 | set ok 0 |
| 540 | 547 | set b "<$cstype $csid>" |
| 541 | 548 | trouble fatal "$fname <$revnr> [string map [list @ $b] $label]" |
| 542 | 549 | } |
| 543 | - log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" | |
| 550 | + log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} | |
| 544 | 551 | return |
| 545 | 552 | } |
| 546 | 553 | |
| 547 | 554 | # # ## ### ##### ######## ############# |
| 548 | 555 | ## Configuration |
| 549 | 556 |
| --- tools/cvs2fossil/lib/c2f_integrity.tcl | |
| +++ tools/cvs2fossil/lib/c2f_integrity.tcl | |
| @@ -26,10 +26,17 @@ | |
| 26 | ## |
| 27 | |
| 28 | snit::type ::vc::fossil::import::cvs::integrity { |
| 29 | # # ## ### ##### ######## ############# |
| 30 | ## Public API |
| 31 | |
| 32 | typemethod strict {} { |
| 33 | log write 4 integrity {Check database consistency} |
| 34 | |
| 35 | set n 0 |
| @@ -515,11 +522,11 @@ | |
| 515 | set ok 1 |
| 516 | foreach {fname revnr} [state run $sql] { |
| 517 | set ok 0 |
| 518 | trouble fatal "$fname <$revnr> $label" |
| 519 | } |
| 520 | log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" |
| 521 | return |
| 522 | } |
| 523 | |
| 524 | proc CheckCS {header label sql} { |
| 525 | upvar 1 n n |
| @@ -526,11 +533,11 @@ | |
| 526 | set ok 1 |
| 527 | foreach {ctype cid} [state run $sql] { |
| 528 | set ok 0 |
| 529 | trouble fatal "<$ctype $cid> $label" |
| 530 | } |
| 531 | log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" |
| 532 | return |
| 533 | } |
| 534 | |
| 535 | proc CheckInCS {header label sql} { |
| 536 | upvar 1 n n |
| @@ -538,11 +545,11 @@ | |
| 538 | foreach {cstype csid fname revnr} [state run $sql] { |
| 539 | set ok 0 |
| 540 | set b "<$cstype $csid>" |
| 541 | trouble fatal "$fname <$revnr> [string map [list @ $b] $label]" |
| 542 | } |
| 543 | log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" |
| 544 | return |
| 545 | } |
| 546 | |
| 547 | # # ## ### ##### ######## ############# |
| 548 | ## Configuration |
| 549 |
| --- tools/cvs2fossil/lib/c2f_integrity.tcl | |
| +++ tools/cvs2fossil/lib/c2f_integrity.tcl | |
| @@ -26,10 +26,17 @@ | |
| 26 | ## |
| 27 | |
| 28 | snit::type ::vc::fossil::import::cvs::integrity { |
| 29 | # # ## ### ##### ######## ############# |
| 30 | ## Public API |
| 31 | |
| 32 | typemethod assert {expression failmessage} { |
| 33 | set ok [uplevel 1 [list ::expr $expression]] |
| 34 | if {$ok} return |
| 35 | trouble internal [uplevel 1 [list ::subst $failmessage]] |
| 36 | return |
| 37 | } |
| 38 | |
| 39 | typemethod strict {} { |
| 40 | log write 4 integrity {Check database consistency} |
| 41 | |
| 42 | set n 0 |
| @@ -515,11 +522,11 @@ | |
| 522 | set ok 1 |
| 523 | foreach {fname revnr} [state run $sql] { |
| 524 | set ok 0 |
| 525 | trouble fatal "$fname <$revnr> $label" |
| 526 | } |
| 527 | log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} |
| 528 | return |
| 529 | } |
| 530 | |
| 531 | proc CheckCS {header label sql} { |
| 532 | upvar 1 n n |
| @@ -526,11 +533,11 @@ | |
| 533 | set ok 1 |
| 534 | foreach {ctype cid} [state run $sql] { |
| 535 | set ok 0 |
| 536 | trouble fatal "<$ctype $cid> $label" |
| 537 | } |
| 538 | log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} |
| 539 | return |
| 540 | } |
| 541 | |
| 542 | proc CheckInCS {header label sql} { |
| 543 | upvar 1 n n |
| @@ -538,11 +545,11 @@ | |
| 545 | foreach {cstype csid fname revnr} [state run $sql] { |
| 546 | set ok 0 |
| 547 | set b "<$cstype $csid>" |
| 548 | trouble fatal "$fname <$revnr> [string map [list @ $b] $label]" |
| 549 | } |
| 550 | log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header} |
| 551 | return |
| 552 | } |
| 553 | |
| 554 | # # ## ### ##### ######## ############# |
| 555 | ## Configuration |
| 556 |
+12
-10
| --- tools/cvs2fossil/lib/c2f_pass.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | ||
| @@ -15,29 +15,30 @@ | ||
| 15 | 15 | ## query this manager to dynamically create the relevant texts. |
| 16 | 16 | |
| 17 | 17 | # # ## ### ##### ######## ############# ##################### |
| 18 | 18 | ## Requirements |
| 19 | 19 | |
| 20 | -package require Tcl 8.4 ; # Required runtime. | |
| 21 | -package require snit ; # OO system. | |
| 22 | -package require vc::fossil::import::cvs::state ; # State storage | |
| 23 | -package require vc::tools::misc ; # Text formatting | |
| 24 | -package require vc::tools::trouble ; # Error reporting. | |
| 25 | -package require vc::tools::log ; # User feedback. | |
| 26 | -package require struct::list ; # Portable lassign | |
| 20 | +package require Tcl 8.4 ; # Required runtime. | |
| 21 | +package require snit ; # OO system. | |
| 22 | +package require vc::fossil::import::cvs::state ; # State storage | |
| 23 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 24 | +package require vc::tools::misc ; # Text formatting | |
| 25 | +package require vc::tools::trouble ; # Error reporting. | |
| 26 | +package require vc::tools::log ; # User feedback. | |
| 27 | +package require struct::list ; # Portable lassign | |
| 27 | 28 | |
| 28 | 29 | # # ## ### ##### ######## ############# ##################### |
| 29 | 30 | ## |
| 30 | 31 | |
| 31 | 32 | snit::type ::vc::fossil::import::cvs::pass { |
| 32 | 33 | # # ## ### ##### ######## ############# |
| 33 | 34 | ## Public API, Methods (Setup, query) |
| 34 | 35 | |
| 35 | 36 | typemethod define {name description command} { |
| 36 | - if {[info exists mydesc($name)]} { | |
| 37 | - trouble internal "Multiple definitions for pass code '$name'" | |
| 38 | - } | |
| 37 | + integrity assert { | |
| 38 | + ![info exists mydesc($name)] | |
| 39 | + } {Multiple definitions for pass code '$name'} | |
| 39 | 40 | lappend mypasses $name |
| 40 | 41 | set mydesc($name) $description |
| 41 | 42 | set mycmd($name) $command |
| 42 | 43 | return |
| 43 | 44 | } |
| @@ -197,10 +198,11 @@ | ||
| 197 | 198 | |
| 198 | 199 | namespace eval ::vc::fossil::import::cvs { |
| 199 | 200 | namespace export pass |
| 200 | 201 | namespace eval pass { |
| 201 | 202 | namespace import ::vc::fossil::import::cvs::state |
| 203 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 202 | 204 | namespace import ::vc::tools::misc::* |
| 203 | 205 | namespace import ::vc::tools::trouble |
| 204 | 206 | namespace import ::vc::tools::log |
| 205 | 207 | log register pass |
| 206 | 208 | } |
| 207 | 209 |
| --- tools/cvs2fossil/lib/c2f_pass.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | |
| @@ -15,29 +15,30 @@ | |
| 15 | ## query this manager to dynamically create the relevant texts. |
| 16 | |
| 17 | # # ## ### ##### ######## ############# ##################### |
| 18 | ## Requirements |
| 19 | |
| 20 | package require Tcl 8.4 ; # Required runtime. |
| 21 | package require snit ; # OO system. |
| 22 | package require vc::fossil::import::cvs::state ; # State storage |
| 23 | package require vc::tools::misc ; # Text formatting |
| 24 | package require vc::tools::trouble ; # Error reporting. |
| 25 | package require vc::tools::log ; # User feedback. |
| 26 | package require struct::list ; # Portable lassign |
| 27 | |
| 28 | # # ## ### ##### ######## ############# ##################### |
| 29 | ## |
| 30 | |
| 31 | snit::type ::vc::fossil::import::cvs::pass { |
| 32 | # # ## ### ##### ######## ############# |
| 33 | ## Public API, Methods (Setup, query) |
| 34 | |
| 35 | typemethod define {name description command} { |
| 36 | if {[info exists mydesc($name)]} { |
| 37 | trouble internal "Multiple definitions for pass code '$name'" |
| 38 | } |
| 39 | lappend mypasses $name |
| 40 | set mydesc($name) $description |
| 41 | set mycmd($name) $command |
| 42 | return |
| 43 | } |
| @@ -197,10 +198,11 @@ | |
| 197 | |
| 198 | namespace eval ::vc::fossil::import::cvs { |
| 199 | namespace export pass |
| 200 | namespace eval pass { |
| 201 | namespace import ::vc::fossil::import::cvs::state |
| 202 | namespace import ::vc::tools::misc::* |
| 203 | namespace import ::vc::tools::trouble |
| 204 | namespace import ::vc::tools::log |
| 205 | log register pass |
| 206 | } |
| 207 |
| --- tools/cvs2fossil/lib/c2f_pass.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | |
| @@ -15,29 +15,30 @@ | |
| 15 | ## query this manager to dynamically create the relevant texts. |
| 16 | |
| 17 | # # ## ### ##### ######## ############# ##################### |
| 18 | ## Requirements |
| 19 | |
| 20 | package require Tcl 8.4 ; # Required runtime. |
| 21 | package require snit ; # OO system. |
| 22 | package require vc::fossil::import::cvs::state ; # State storage |
| 23 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 24 | package require vc::tools::misc ; # Text formatting |
| 25 | package require vc::tools::trouble ; # Error reporting. |
| 26 | package require vc::tools::log ; # User feedback. |
| 27 | package require struct::list ; # Portable lassign |
| 28 | |
| 29 | # # ## ### ##### ######## ############# ##################### |
| 30 | ## |
| 31 | |
| 32 | snit::type ::vc::fossil::import::cvs::pass { |
| 33 | # # ## ### ##### ######## ############# |
| 34 | ## Public API, Methods (Setup, query) |
| 35 | |
| 36 | typemethod define {name description command} { |
| 37 | integrity assert { |
| 38 | ![info exists mydesc($name)] |
| 39 | } {Multiple definitions for pass code '$name'} |
| 40 | lappend mypasses $name |
| 41 | set mydesc($name) $description |
| 42 | set mycmd($name) $command |
| 43 | return |
| 44 | } |
| @@ -197,10 +198,11 @@ | |
| 198 | |
| 199 | namespace eval ::vc::fossil::import::cvs { |
| 200 | namespace export pass |
| 201 | namespace eval pass { |
| 202 | namespace import ::vc::fossil::import::cvs::state |
| 203 | namespace import ::vc::fossil::import::cvs::integrity |
| 204 | namespace import ::vc::tools::misc::* |
| 205 | namespace import ::vc::tools::trouble |
| 206 | namespace import ::vc::tools::log |
| 207 | log register pass |
| 208 | } |
| 209 |
| --- tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | ||
| @@ -174,13 +174,13 @@ | ||
| 174 | 174 | # At last check that the normal frament is indeed not |
| 175 | 175 | # backward, and iterate over the possibly still backward |
| 176 | 176 | # second fragment. |
| 177 | 177 | |
| 178 | 178 | struct::list assign $replacements normal backward |
| 179 | - if {[IsBackward $graph $normal]} { | |
| 180 | - trouble internal "The normal fragment is unexpectedly backward" | |
| 181 | - } | |
| 179 | + integrity assert { | |
| 180 | + ![IsBackward $graph $normal] | |
| 181 | + } {The normal fragment is unexpectedly backward} | |
| 182 | 182 | |
| 183 | 183 | set cset $backward |
| 184 | 184 | } |
| 185 | 185 | return |
| 186 | 186 | } |
| @@ -259,14 +259,13 @@ | ||
| 259 | 259 | # wrong. |
| 260 | 260 | |
| 261 | 261 | foreach revision [array names limits] { |
| 262 | 262 | struct::list assign $limits($revision) maxp mins |
| 263 | 263 | # Handle min successor position "" as representing infinity |
| 264 | - if {$mins eq ""} continue | |
| 265 | - if {$maxp < $mins} continue | |
| 266 | - | |
| 267 | - trouble internal "Branch revision $revision is backward at file level ($maxp >= $mins)" | |
| 264 | + integrity assert { | |
| 265 | + ($mins eq "") || ($maxp < $mins) | |
| 266 | + } {Branch revision $revision is backward at file level ($maxp >= $mins)} | |
| 268 | 267 | } |
| 269 | 268 | |
| 270 | 269 | # Save the limits for the splitter, and compute the border at |
| 271 | 270 | # which to split as the minimum of all minimal successor |
| 272 | 271 | # positions. |
| @@ -299,12 +298,12 @@ | ||
| 299 | 298 | } else { |
| 300 | 299 | lappend normalrevisions $rev |
| 301 | 300 | } |
| 302 | 301 | } |
| 303 | 302 | |
| 304 | - if {![llength $normalrevisions]} { trouble internal "Set of normal revisions is empty" } | |
| 305 | - if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" } | |
| 303 | + integrity assert {[llength $normalrevisions]} {Set of normal revisions is empty} | |
| 304 | + integrity assert {[llength $backwardrevisions]} {Set of backward revisions is empty} | |
| 306 | 305 | return |
| 307 | 306 | } |
| 308 | 307 | |
| 309 | 308 | |
| 310 | 309 | # # ## ### ##### ######## ############# |
| @@ -369,11 +368,11 @@ | ||
| 369 | 368 | } else { |
| 370 | 369 | ::variable mycset |
| 371 | 370 | set old [$mycset($mylastpos) str]@$mylastpos |
| 372 | 371 | } |
| 373 | 372 | |
| 374 | - trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old" | |
| 373 | + integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old} | |
| 375 | 374 | } |
| 376 | 375 | |
| 377 | 376 | set mylastpos $new |
| 378 | 377 | return |
| 379 | 378 | } |
| 380 | 379 |
| --- tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | |
| @@ -174,13 +174,13 @@ | |
| 174 | # At last check that the normal frament is indeed not |
| 175 | # backward, and iterate over the possibly still backward |
| 176 | # second fragment. |
| 177 | |
| 178 | struct::list assign $replacements normal backward |
| 179 | if {[IsBackward $graph $normal]} { |
| 180 | trouble internal "The normal fragment is unexpectedly backward" |
| 181 | } |
| 182 | |
| 183 | set cset $backward |
| 184 | } |
| 185 | return |
| 186 | } |
| @@ -259,14 +259,13 @@ | |
| 259 | # wrong. |
| 260 | |
| 261 | foreach revision [array names limits] { |
| 262 | struct::list assign $limits($revision) maxp mins |
| 263 | # Handle min successor position "" as representing infinity |
| 264 | if {$mins eq ""} continue |
| 265 | if {$maxp < $mins} continue |
| 266 | |
| 267 | trouble internal "Branch revision $revision is backward at file level ($maxp >= $mins)" |
| 268 | } |
| 269 | |
| 270 | # Save the limits for the splitter, and compute the border at |
| 271 | # which to split as the minimum of all minimal successor |
| 272 | # positions. |
| @@ -299,12 +298,12 @@ | |
| 299 | } else { |
| 300 | lappend normalrevisions $rev |
| 301 | } |
| 302 | } |
| 303 | |
| 304 | if {![llength $normalrevisions]} { trouble internal "Set of normal revisions is empty" } |
| 305 | if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" } |
| 306 | return |
| 307 | } |
| 308 | |
| 309 | |
| 310 | # # ## ### ##### ######## ############# |
| @@ -369,11 +368,11 @@ | |
| 369 | } else { |
| 370 | ::variable mycset |
| 371 | set old [$mycset($mylastpos) str]@$mylastpos |
| 372 | } |
| 373 | |
| 374 | trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old" |
| 375 | } |
| 376 | |
| 377 | set mylastpos $new |
| 378 | return |
| 379 | } |
| 380 |
| --- tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pbreakacycle.tcl | |
| @@ -174,13 +174,13 @@ | |
| 174 | # At last check that the normal frament is indeed not |
| 175 | # backward, and iterate over the possibly still backward |
| 176 | # second fragment. |
| 177 | |
| 178 | struct::list assign $replacements normal backward |
| 179 | integrity assert { |
| 180 | ![IsBackward $graph $normal] |
| 181 | } {The normal fragment is unexpectedly backward} |
| 182 | |
| 183 | set cset $backward |
| 184 | } |
| 185 | return |
| 186 | } |
| @@ -259,14 +259,13 @@ | |
| 259 | # wrong. |
| 260 | |
| 261 | foreach revision [array names limits] { |
| 262 | struct::list assign $limits($revision) maxp mins |
| 263 | # Handle min successor position "" as representing infinity |
| 264 | integrity assert { |
| 265 | ($mins eq "") || ($maxp < $mins) |
| 266 | } {Branch revision $revision is backward at file level ($maxp >= $mins)} |
| 267 | } |
| 268 | |
| 269 | # Save the limits for the splitter, and compute the border at |
| 270 | # which to split as the minimum of all minimal successor |
| 271 | # positions. |
| @@ -299,12 +298,12 @@ | |
| 298 | } else { |
| 299 | lappend normalrevisions $rev |
| 300 | } |
| 301 | } |
| 302 | |
| 303 | integrity assert {[llength $normalrevisions]} {Set of normal revisions is empty} |
| 304 | integrity assert {[llength $backwardrevisions]} {Set of backward revisions is empty} |
| 305 | return |
| 306 | } |
| 307 | |
| 308 | |
| 309 | # # ## ### ##### ######## ############# |
| @@ -369,11 +368,11 @@ | |
| 368 | } else { |
| 369 | ::variable mycset |
| 370 | set old [$mycset($mylastpos) str]@$mylastpos |
| 371 | } |
| 372 | |
| 373 | integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old} |
| 374 | } |
| 375 | |
| 376 | set mylastpos $new |
| 377 | return |
| 378 | } |
| 379 |
| --- tools/cvs2fossil/lib/c2f_pfiltersym.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pfiltersym.tcl | ||
| @@ -380,11 +380,11 @@ | ||
| 380 | 380 | set oldname $sx($lod) |
| 381 | 381 | struct::list assign $fpn($fid) fname prname |
| 382 | 382 | |
| 383 | 383 | # Do the grafting. |
| 384 | 384 | |
| 385 | - log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'" | |
| 385 | + log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'} | |
| 386 | 386 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 387 | 387 | incr n |
| 388 | 388 | } |
| 389 | 389 | |
| 390 | 390 | log write 3 filtersym "Reparented [nsp $n tag]" |
| @@ -438,11 +438,11 @@ | ||
| 438 | 438 | set oldname $sx($lod) |
| 439 | 439 | struct::list assign $fpn($fid) fname prname |
| 440 | 440 | |
| 441 | 441 | # Do the grafting. |
| 442 | 442 | |
| 443 | - log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'" | |
| 443 | + log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'} | |
| 444 | 444 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 445 | 445 | incr n |
| 446 | 446 | } |
| 447 | 447 | |
| 448 | 448 | log write 3 filtersym "Reparented [nsp $n branch branches]" |
| 449 | 449 |
| --- tools/cvs2fossil/lib/c2f_pfiltersym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pfiltersym.tcl | |
| @@ -380,11 +380,11 @@ | |
| 380 | set oldname $sx($lod) |
| 381 | struct::list assign $fpn($fid) fname prname |
| 382 | |
| 383 | # Do the grafting. |
| 384 | |
| 385 | log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'" |
| 386 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 387 | incr n |
| 388 | } |
| 389 | |
| 390 | log write 3 filtersym "Reparented [nsp $n tag]" |
| @@ -438,11 +438,11 @@ | |
| 438 | set oldname $sx($lod) |
| 439 | struct::list assign $fpn($fid) fname prname |
| 440 | |
| 441 | # Do the grafting. |
| 442 | |
| 443 | log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'" |
| 444 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 445 | incr n |
| 446 | } |
| 447 | |
| 448 | log write 3 filtersym "Reparented [nsp $n branch branches]" |
| 449 |
| --- tools/cvs2fossil/lib/c2f_pfiltersym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pfiltersym.tcl | |
| @@ -380,11 +380,11 @@ | |
| 380 | set oldname $sx($lod) |
| 381 | struct::list assign $fpn($fid) fname prname |
| 382 | |
| 383 | # Do the grafting. |
| 384 | |
| 385 | log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'} |
| 386 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 387 | incr n |
| 388 | } |
| 389 | |
| 390 | log write 3 filtersym "Reparented [nsp $n tag]" |
| @@ -438,11 +438,11 @@ | |
| 438 | set oldname $sx($lod) |
| 439 | struct::list assign $fpn($fid) fname prname |
| 440 | |
| 441 | # Do the grafting. |
| 442 | |
| 443 | log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'} |
| 444 | state run { UPDATE tag SET lod = $pid WHERE tid = $id ; } |
| 445 | incr n |
| 446 | } |
| 447 | |
| 448 | log write 3 filtersym "Reparented [nsp $n branch branches]" |
| 449 |
+18
-30
| --- tools/cvs2fossil/lib/c2f_prev.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | ||
| @@ -20,10 +20,11 @@ | ||
| 20 | 20 | package require snit ; # OO system. |
| 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 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 25 | 26 | package require vc::fossil::import::cvs::project::sym ; # Project level symbols |
| 26 | 27 | |
| 27 | 28 | # # ## ### ##### ######## ############# ##################### |
| 28 | 29 | ## |
| 29 | 30 | |
| @@ -200,13 +201,13 @@ | ||
| 200 | 201 | array set breaks {} |
| 201 | 202 | |
| 202 | 203 | while {$at < [llength $pending]} { |
| 203 | 204 | set current [lindex $pending $at] |
| 204 | 205 | |
| 205 | - log write 6 csets ". . .. ... ..... ........ ............." | |
| 206 | - log write 6 csets "Scheduled [join [PRs [lrange $pending $at end]] { }]" | |
| 207 | - log write 6 csets "Considering [PR $current] \[$at/[llength $pending]\]" | |
| 206 | + log write 6 csets {. . .. ... ..... ........ .............} | |
| 207 | + log write 6 csets {Scheduled [join [PRs [lrange $pending $at end]] { }]} | |
| 208 | + log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]} | |
| 208 | 209 | |
| 209 | 210 | set best [FindBestBreak $current] |
| 210 | 211 | |
| 211 | 212 | if {$best < 0} { |
| 212 | 213 | # The inspected range has no internal |
| @@ -233,16 +234,12 @@ | ||
| 233 | 234 | set fragbefore [lrange $current 0 $brel] |
| 234 | 235 | set fragafter [lrange $current $bnext end] |
| 235 | 236 | |
| 236 | 237 | log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" |
| 237 | 238 | |
| 238 | - if {![llength $fragbefore]} { | |
| 239 | - trouble internal "Tried to split off a zero-length fragment at the beginning" | |
| 240 | - } | |
| 241 | - if {![llength $fragafter]} { | |
| 242 | - trouble internal "Tried to split off a zero-length fragment at the end" | |
| 243 | - } | |
| 239 | + integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning} | |
| 240 | + integrity assert {[llength $fragafter]} {Found zero-length fragment at the end} | |
| 244 | 241 | |
| 245 | 242 | lappend pending $fragbefore $fragafter |
| 246 | 243 | CutAt $best |
| 247 | 244 | } |
| 248 | 245 | |
| @@ -266,31 +263,27 @@ | ||
| 266 | 263 | |
| 267 | 264 | #puts \t.[join [PRs $fragments] .\n\t.]. |
| 268 | 265 | |
| 269 | 266 | Border [lindex $fragments 0] firsts firste |
| 270 | 267 | |
| 271 | - if {$firsts != 0} { | |
| 272 | - trouble internal "Bad fragment start @ $firsts, gap, or before beginning of the range" | |
| 273 | - } | |
| 268 | + integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range} | |
| 274 | 269 | |
| 275 | 270 | set laste $firste |
| 276 | 271 | foreach fragment [lrange $fragments 1 end] { |
| 277 | 272 | Border $fragment s e |
| 278 | - if {$laste != ($s - 1)} { | |
| 279 | - trouble internal "Bad fragment border <$laste | $s>, gap or overlap" | |
| 280 | - } | |
| 273 | + integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap} | |
| 281 | 274 | |
| 282 | 275 | set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]] |
| 283 | 276 | |
| 284 | 277 | log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)" |
| 285 | 278 | |
| 286 | 279 | set laste $e |
| 287 | 280 | } |
| 288 | 281 | |
| 289 | - if {$laste != ([llength $myrevisions]-1)} { | |
| 290 | - trouble internal "Bad fragment end @ $laste, gap, or beyond end of the range" | |
| 291 | - } | |
| 282 | + integrity assert { | |
| 283 | + $laste == ([llength $myrevisions]-1) | |
| 284 | + } {Bad fragment end @ $laste, gap, or beyond end of the range} | |
| 292 | 285 | |
| 293 | 286 | # Put the first fragment into the current changeset, and |
| 294 | 287 | # update the in-memory index. We can simply (re)add the |
| 295 | 288 | # revisions because we cleared the previously existing |
| 296 | 289 | # information, see (*) above. Persistence does not matter |
| @@ -365,13 +358,13 @@ | ||
| 365 | 358 | $cset drop |
| 366 | 359 | $cset destroy |
| 367 | 360 | |
| 368 | 361 | set newcsets {} |
| 369 | 362 | foreach fragmentrevisions $args { |
| 370 | - if {![llength $fragmentrevisions]} { | |
| 371 | - trouble internal "Attempted to create an empty changeset, i.e. without revisions" | |
| 372 | - } | |
| 363 | + integrity assert { | |
| 364 | + [llength $fragmentrevisions] | |
| 365 | + } {Attempted to create an empty changeset, i.e. without revisions} | |
| 373 | 366 | lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions] |
| 374 | 367 | } |
| 375 | 368 | |
| 376 | 369 | foreach c $newcsets { $c persist } |
| 377 | 370 | return $newcsets |
| @@ -464,13 +457,11 @@ | ||
| 464 | 457 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 465 | 458 | AND RA.child IS NOT NULL -- Has primary child. |
| 466 | 459 | AND RA.child IN $theset -- Which is also of interest |
| 467 | 460 | "] { |
| 468 | 461 | # Consider moving this to the integrity module. |
| 469 | - if {$rid == $child} { | |
| 470 | - trouble internal "Revision $rid depends on itself." | |
| 471 | - } | |
| 462 | + integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 472 | 463 | lappend dependencies($rid) $child |
| 473 | 464 | set dep($rid,$child) . |
| 474 | 465 | } |
| 475 | 466 | |
| 476 | 467 | # The sql statements above looks only for direct dependencies |
| @@ -564,13 +555,11 @@ | ||
| 564 | 555 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 565 | 556 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 566 | 557 | AND RA.child IS NOT NULL -- Has primary child. |
| 567 | 558 | "] { |
| 568 | 559 | # Consider moving this to the integrity module. |
| 569 | - if {$rid == $child} { | |
| 570 | - trouble internal "Revision $rid depends on itself." | |
| 571 | - } | |
| 560 | + integrity assert {$rid != $child} {Revision $rid depends on itself.} | |
| 572 | 561 | lappend dependencies($rid) $child |
| 573 | 562 | } |
| 574 | 563 | return |
| 575 | 564 | } |
| 576 | 565 | |
| @@ -611,13 +600,11 @@ | ||
| 611 | 600 | AND R.parent IS NOT NULL -- which are not root |
| 612 | 601 | AND RA.rid = R.parent -- go to their parent |
| 613 | 602 | AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root |
| 614 | 603 | "] { |
| 615 | 604 | # Consider moving this to the integrity module. |
| 616 | - if {$rid == $parent} { | |
| 617 | - trouble internal "Revision $rid depends on itself." | |
| 618 | - } | |
| 605 | + integrity assert {$rid != $parent} {Revision $rid depends on itself.} | |
| 619 | 606 | lappend dependencies($rid) $parent |
| 620 | 607 | } |
| 621 | 608 | return |
| 622 | 609 | } |
| 623 | 610 | |
| @@ -860,10 +847,11 @@ | ||
| 860 | 847 | |
| 861 | 848 | namespace eval ::vc::fossil::import::cvs::project { |
| 862 | 849 | namespace export rev |
| 863 | 850 | namespace eval rev { |
| 864 | 851 | namespace import ::vc::fossil::import::cvs::state |
| 852 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 865 | 853 | namespace eval project { |
| 866 | 854 | namespace import ::vc::fossil::import::cvs::project::sym |
| 867 | 855 | } |
| 868 | 856 | ::variable mybranchcode [project::sym branch] |
| 869 | 857 | namespace import ::vc::tools::misc::* |
| 870 | 858 |
| --- tools/cvs2fossil/lib/c2f_prev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | |
| @@ -20,10 +20,11 @@ | |
| 20 | package require snit ; # OO system. |
| 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::project::sym ; # Project level symbols |
| 26 | |
| 27 | # # ## ### ##### ######## ############# ##################### |
| 28 | ## |
| 29 | |
| @@ -200,13 +201,13 @@ | |
| 200 | array set breaks {} |
| 201 | |
| 202 | while {$at < [llength $pending]} { |
| 203 | set current [lindex $pending $at] |
| 204 | |
| 205 | log write 6 csets ". . .. ... ..... ........ ............." |
| 206 | log write 6 csets "Scheduled [join [PRs [lrange $pending $at end]] { }]" |
| 207 | log write 6 csets "Considering [PR $current] \[$at/[llength $pending]\]" |
| 208 | |
| 209 | set best [FindBestBreak $current] |
| 210 | |
| 211 | if {$best < 0} { |
| 212 | # The inspected range has no internal |
| @@ -233,16 +234,12 @@ | |
| 233 | set fragbefore [lrange $current 0 $brel] |
| 234 | set fragafter [lrange $current $bnext end] |
| 235 | |
| 236 | log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" |
| 237 | |
| 238 | if {![llength $fragbefore]} { |
| 239 | trouble internal "Tried to split off a zero-length fragment at the beginning" |
| 240 | } |
| 241 | if {![llength $fragafter]} { |
| 242 | trouble internal "Tried to split off a zero-length fragment at the end" |
| 243 | } |
| 244 | |
| 245 | lappend pending $fragbefore $fragafter |
| 246 | CutAt $best |
| 247 | } |
| 248 | |
| @@ -266,31 +263,27 @@ | |
| 266 | |
| 267 | #puts \t.[join [PRs $fragments] .\n\t.]. |
| 268 | |
| 269 | Border [lindex $fragments 0] firsts firste |
| 270 | |
| 271 | if {$firsts != 0} { |
| 272 | trouble internal "Bad fragment start @ $firsts, gap, or before beginning of the range" |
| 273 | } |
| 274 | |
| 275 | set laste $firste |
| 276 | foreach fragment [lrange $fragments 1 end] { |
| 277 | Border $fragment s e |
| 278 | if {$laste != ($s - 1)} { |
| 279 | trouble internal "Bad fragment border <$laste | $s>, gap or overlap" |
| 280 | } |
| 281 | |
| 282 | set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]] |
| 283 | |
| 284 | log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)" |
| 285 | |
| 286 | set laste $e |
| 287 | } |
| 288 | |
| 289 | if {$laste != ([llength $myrevisions]-1)} { |
| 290 | trouble internal "Bad fragment end @ $laste, gap, or beyond end of the range" |
| 291 | } |
| 292 | |
| 293 | # Put the first fragment into the current changeset, and |
| 294 | # update the in-memory index. We can simply (re)add the |
| 295 | # revisions because we cleared the previously existing |
| 296 | # information, see (*) above. Persistence does not matter |
| @@ -365,13 +358,13 @@ | |
| 365 | $cset drop |
| 366 | $cset destroy |
| 367 | |
| 368 | set newcsets {} |
| 369 | foreach fragmentrevisions $args { |
| 370 | if {![llength $fragmentrevisions]} { |
| 371 | trouble internal "Attempted to create an empty changeset, i.e. without revisions" |
| 372 | } |
| 373 | lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions] |
| 374 | } |
| 375 | |
| 376 | foreach c $newcsets { $c persist } |
| 377 | return $newcsets |
| @@ -464,13 +457,11 @@ | |
| 464 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 465 | AND RA.child IS NOT NULL -- Has primary child. |
| 466 | AND RA.child IN $theset -- Which is also of interest |
| 467 | "] { |
| 468 | # Consider moving this to the integrity module. |
| 469 | if {$rid == $child} { |
| 470 | trouble internal "Revision $rid depends on itself." |
| 471 | } |
| 472 | lappend dependencies($rid) $child |
| 473 | set dep($rid,$child) . |
| 474 | } |
| 475 | |
| 476 | # The sql statements above looks only for direct dependencies |
| @@ -564,13 +555,11 @@ | |
| 564 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 565 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 566 | AND RA.child IS NOT NULL -- Has primary child. |
| 567 | "] { |
| 568 | # Consider moving this to the integrity module. |
| 569 | if {$rid == $child} { |
| 570 | trouble internal "Revision $rid depends on itself." |
| 571 | } |
| 572 | lappend dependencies($rid) $child |
| 573 | } |
| 574 | return |
| 575 | } |
| 576 | |
| @@ -611,13 +600,11 @@ | |
| 611 | AND R.parent IS NOT NULL -- which are not root |
| 612 | AND RA.rid = R.parent -- go to their parent |
| 613 | AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root |
| 614 | "] { |
| 615 | # Consider moving this to the integrity module. |
| 616 | if {$rid == $parent} { |
| 617 | trouble internal "Revision $rid depends on itself." |
| 618 | } |
| 619 | lappend dependencies($rid) $parent |
| 620 | } |
| 621 | return |
| 622 | } |
| 623 | |
| @@ -860,10 +847,11 @@ | |
| 860 | |
| 861 | namespace eval ::vc::fossil::import::cvs::project { |
| 862 | namespace export rev |
| 863 | namespace eval rev { |
| 864 | namespace import ::vc::fossil::import::cvs::state |
| 865 | namespace eval project { |
| 866 | namespace import ::vc::fossil::import::cvs::project::sym |
| 867 | } |
| 868 | ::variable mybranchcode [project::sym branch] |
| 869 | namespace import ::vc::tools::misc::* |
| 870 |
| --- tools/cvs2fossil/lib/c2f_prev.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prev.tcl | |
| @@ -20,10 +20,11 @@ | |
| 20 | package require snit ; # OO system. |
| 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 | |
| @@ -200,13 +201,13 @@ | |
| 201 | array set breaks {} |
| 202 | |
| 203 | while {$at < [llength $pending]} { |
| 204 | set current [lindex $pending $at] |
| 205 | |
| 206 | log write 6 csets {. . .. ... ..... ........ .............} |
| 207 | log write 6 csets {Scheduled [join [PRs [lrange $pending $at end]] { }]} |
| 208 | log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]} |
| 209 | |
| 210 | set best [FindBestBreak $current] |
| 211 | |
| 212 | if {$best < 0} { |
| 213 | # The inspected range has no internal |
| @@ -233,16 +234,12 @@ | |
| 234 | set fragbefore [lrange $current 0 $brel] |
| 235 | set fragafter [lrange $current $bnext end] |
| 236 | |
| 237 | log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" |
| 238 | |
| 239 | integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning} |
| 240 | integrity assert {[llength $fragafter]} {Found zero-length fragment at the end} |
| 241 | |
| 242 | lappend pending $fragbefore $fragafter |
| 243 | CutAt $best |
| 244 | } |
| 245 | |
| @@ -266,31 +263,27 @@ | |
| 263 | |
| 264 | #puts \t.[join [PRs $fragments] .\n\t.]. |
| 265 | |
| 266 | Border [lindex $fragments 0] firsts firste |
| 267 | |
| 268 | integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range} |
| 269 | |
| 270 | set laste $firste |
| 271 | foreach fragment [lrange $fragments 1 end] { |
| 272 | Border $fragment s e |
| 273 | integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap} |
| 274 | |
| 275 | set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]] |
| 276 | |
| 277 | log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)" |
| 278 | |
| 279 | set laste $e |
| 280 | } |
| 281 | |
| 282 | integrity assert { |
| 283 | $laste == ([llength $myrevisions]-1) |
| 284 | } {Bad fragment end @ $laste, gap, or beyond end of the range} |
| 285 | |
| 286 | # Put the first fragment into the current changeset, and |
| 287 | # update the in-memory index. We can simply (re)add the |
| 288 | # revisions because we cleared the previously existing |
| 289 | # information, see (*) above. Persistence does not matter |
| @@ -365,13 +358,13 @@ | |
| 358 | $cset drop |
| 359 | $cset destroy |
| 360 | |
| 361 | set newcsets {} |
| 362 | foreach fragmentrevisions $args { |
| 363 | integrity assert { |
| 364 | [llength $fragmentrevisions] |
| 365 | } {Attempted to create an empty changeset, i.e. without revisions} |
| 366 | lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions] |
| 367 | } |
| 368 | |
| 369 | foreach c $newcsets { $c persist } |
| 370 | return $newcsets |
| @@ -464,13 +457,11 @@ | |
| 457 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 458 | AND RA.child IS NOT NULL -- Has primary child. |
| 459 | AND RA.child IN $theset -- Which is also of interest |
| 460 | "] { |
| 461 | # Consider moving this to the integrity module. |
| 462 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 463 | lappend dependencies($rid) $child |
| 464 | set dep($rid,$child) . |
| 465 | } |
| 466 | |
| 467 | # The sql statements above looks only for direct dependencies |
| @@ -564,13 +555,11 @@ | |
| 555 | AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk |
| 556 | AND RA.rid = R.dbchild -- Go directly to trunk root |
| 557 | AND RA.child IS NOT NULL -- Has primary child. |
| 558 | "] { |
| 559 | # Consider moving this to the integrity module. |
| 560 | integrity assert {$rid != $child} {Revision $rid depends on itself.} |
| 561 | lappend dependencies($rid) $child |
| 562 | } |
| 563 | return |
| 564 | } |
| 565 | |
| @@ -611,13 +600,11 @@ | |
| 600 | AND R.parent IS NOT NULL -- which are not root |
| 601 | AND RA.rid = R.parent -- go to their parent |
| 602 | AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root |
| 603 | "] { |
| 604 | # Consider moving this to the integrity module. |
| 605 | integrity assert {$rid != $parent} {Revision $rid depends on itself.} |
| 606 | lappend dependencies($rid) $parent |
| 607 | } |
| 608 | return |
| 609 | } |
| 610 | |
| @@ -860,10 +847,11 @@ | |
| 847 | |
| 848 | namespace eval ::vc::fossil::import::cvs::project { |
| 849 | namespace export rev |
| 850 | namespace eval rev { |
| 851 | namespace import ::vc::fossil::import::cvs::state |
| 852 | namespace import ::vc::fossil::import::cvs::integrity |
| 853 | namespace eval project { |
| 854 | namespace import ::vc::fossil::import::cvs::project::sym |
| 855 | } |
| 856 | ::variable mybranchcode [project::sym branch] |
| 857 | namespace import ::vc::tools::misc::* |
| 858 |
| --- tools/cvs2fossil/lib/c2f_prevlink.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_prevlink.tcl | ||
| @@ -26,10 +26,11 @@ | ||
| 26 | 26 | package require snit ; # OO system. |
| 27 | 27 | package require vc::tools::misc ; # Text formatting |
| 28 | 28 | package require vc::tools::trouble ; # Error reporting. |
| 29 | 29 | package require vc::tools::log ; # User feedback. |
| 30 | 30 | package require vc::fossil::import::cvs::state ; # State storage. |
| 31 | +package require vc::fossil::import::cvs::integrity ; # State integrity checks. | |
| 31 | 32 | package require vc::fossil::import::cvs::project::rev ; # Project level changesets |
| 32 | 33 | |
| 33 | 34 | # # ## ### ##### ######## ############# ##################### |
| 34 | 35 | ## |
| 35 | 36 | |
| @@ -122,13 +123,11 @@ | ||
| 122 | 123 | |
| 123 | 124 | return 0 ; # Self is worse or equal, i.e. not better. |
| 124 | 125 | } |
| 125 | 126 | |
| 126 | 127 | method break {} { |
| 127 | - if {![$self breakable]} { | |
| 128 | - trouble internal "Changeset [$mycset str] is not breakable." | |
| 129 | - } | |
| 128 | + integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.} | |
| 130 | 129 | |
| 131 | 130 | # One thing to choose when splitting CSET is where the |
| 132 | 131 | # revision in categories 1 and 2 (none and passthrough |
| 133 | 132 | # respectively) are moved to. This is done using the counters. |
| 134 | 133 | |
| @@ -217,10 +216,11 @@ | ||
| 217 | 216 | |
| 218 | 217 | namespace eval ::vc::fossil::import::cvs::project { |
| 219 | 218 | namespace export revlink |
| 220 | 219 | namespace eval revlink { |
| 221 | 220 | namespace import ::vc::fossil::import::cvs::state |
| 221 | + namespace import ::vc::fossil::import::cvs::integrity | |
| 222 | 222 | namespace import ::vc::tools::misc::* |
| 223 | 223 | namespace import ::vc::tools::trouble |
| 224 | 224 | namespace eval project { |
| 225 | 225 | namespace import ::vc::fossil::import::cvs::project::rev |
| 226 | 226 | } |
| 227 | 227 |
| --- tools/cvs2fossil/lib/c2f_prevlink.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prevlink.tcl | |
| @@ -26,10 +26,11 @@ | |
| 26 | package require snit ; # OO system. |
| 27 | package require vc::tools::misc ; # Text formatting |
| 28 | package require vc::tools::trouble ; # Error reporting. |
| 29 | package require vc::tools::log ; # User feedback. |
| 30 | package require vc::fossil::import::cvs::state ; # State storage. |
| 31 | package require vc::fossil::import::cvs::project::rev ; # Project level changesets |
| 32 | |
| 33 | # # ## ### ##### ######## ############# ##################### |
| 34 | ## |
| 35 | |
| @@ -122,13 +123,11 @@ | |
| 122 | |
| 123 | return 0 ; # Self is worse or equal, i.e. not better. |
| 124 | } |
| 125 | |
| 126 | method break {} { |
| 127 | if {![$self breakable]} { |
| 128 | trouble internal "Changeset [$mycset str] is not breakable." |
| 129 | } |
| 130 | |
| 131 | # One thing to choose when splitting CSET is where the |
| 132 | # revision in categories 1 and 2 (none and passthrough |
| 133 | # respectively) are moved to. This is done using the counters. |
| 134 | |
| @@ -217,10 +216,11 @@ | |
| 217 | |
| 218 | namespace eval ::vc::fossil::import::cvs::project { |
| 219 | namespace export revlink |
| 220 | namespace eval revlink { |
| 221 | namespace import ::vc::fossil::import::cvs::state |
| 222 | namespace import ::vc::tools::misc::* |
| 223 | namespace import ::vc::tools::trouble |
| 224 | namespace eval project { |
| 225 | namespace import ::vc::fossil::import::cvs::project::rev |
| 226 | } |
| 227 |
| --- tools/cvs2fossil/lib/c2f_prevlink.tcl | |
| +++ tools/cvs2fossil/lib/c2f_prevlink.tcl | |
| @@ -26,10 +26,11 @@ | |
| 26 | package require snit ; # OO system. |
| 27 | package require vc::tools::misc ; # Text formatting |
| 28 | package require vc::tools::trouble ; # Error reporting. |
| 29 | package require vc::tools::log ; # User feedback. |
| 30 | package require vc::fossil::import::cvs::state ; # State storage. |
| 31 | package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
| 32 | package require vc::fossil::import::cvs::project::rev ; # Project level changesets |
| 33 | |
| 34 | # # ## ### ##### ######## ############# ##################### |
| 35 | ## |
| 36 | |
| @@ -122,13 +123,11 @@ | |
| 123 | |
| 124 | return 0 ; # Self is worse or equal, i.e. not better. |
| 125 | } |
| 126 | |
| 127 | method break {} { |
| 128 | integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.} |
| 129 | |
| 130 | # One thing to choose when splitting CSET is where the |
| 131 | # revision in categories 1 and 2 (none and passthrough |
| 132 | # respectively) are moved to. This is done using the counters. |
| 133 | |
| @@ -217,10 +216,11 @@ | |
| 216 | |
| 217 | namespace eval ::vc::fossil::import::cvs::project { |
| 218 | namespace export revlink |
| 219 | namespace eval revlink { |
| 220 | namespace import ::vc::fossil::import::cvs::state |
| 221 | namespace import ::vc::fossil::import::cvs::integrity |
| 222 | namespace import ::vc::tools::misc::* |
| 223 | namespace import ::vc::tools::trouble |
| 224 | namespace eval project { |
| 225 | namespace import ::vc::fossil::import::cvs::project::rev |
| 226 | } |
| 227 |
| --- tools/cvs2fossil/lib/c2f_psym.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_psym.tcl | ||
| @@ -366,11 +366,11 @@ | ||
| 366 | 366 | if {$mytagcount < $mybranchcount} { return $mybranch } |
| 367 | 367 | return $myundef |
| 368 | 368 | } |
| 369 | 369 | |
| 370 | 370 | method MarkAs {label chosen} { |
| 371 | - log write 3 symbol "\[$label\] Converting symbol '$myname' as $mysymtype($chosen)" | |
| 371 | + log write 3 symbol {\[$label\] Converting symbol '$myname' as $mysymtype($chosen)} | |
| 372 | 372 | |
| 373 | 373 | set mytype $chosen |
| 374 | 374 | incr myrulecount($label) |
| 375 | 375 | |
| 376 | 376 | # This is stored directly into the database. |
| 377 | 377 |
| --- tools/cvs2fossil/lib/c2f_psym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_psym.tcl | |
| @@ -366,11 +366,11 @@ | |
| 366 | if {$mytagcount < $mybranchcount} { return $mybranch } |
| 367 | return $myundef |
| 368 | } |
| 369 | |
| 370 | method MarkAs {label chosen} { |
| 371 | log write 3 symbol "\[$label\] Converting symbol '$myname' as $mysymtype($chosen)" |
| 372 | |
| 373 | set mytype $chosen |
| 374 | incr myrulecount($label) |
| 375 | |
| 376 | # This is stored directly into the database. |
| 377 |
| --- tools/cvs2fossil/lib/c2f_psym.tcl | |
| +++ tools/cvs2fossil/lib/c2f_psym.tcl | |
| @@ -366,11 +366,11 @@ | |
| 366 | if {$mytagcount < $mybranchcount} { return $mybranch } |
| 367 | return $myundef |
| 368 | } |
| 369 | |
| 370 | method MarkAs {label chosen} { |
| 371 | log write 3 symbol {\[$label\] Converting symbol '$myname' as $mysymtype($chosen)} |
| 372 | |
| 373 | set mytype $chosen |
| 374 | incr myrulecount($label) |
| 375 | |
| 376 | # This is stored directly into the database. |
| 377 |
| --- tools/cvs2fossil/lib/c2f_state.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_state.tcl | ||
| @@ -122,12 +122,12 @@ | ||
| 122 | 122 | WHERE type = 'table' |
| 123 | 123 | AND name = $name |
| 124 | 124 | ; |
| 125 | 125 | }]] |
| 126 | 126 | |
| 127 | + # No assert, would cause cycle in package dependencies | |
| 127 | 128 | if {$found} return |
| 128 | - | |
| 129 | 129 | trouble internal "The required table \"$name\" is not defined." |
| 130 | 130 | # Not reached |
| 131 | 131 | return |
| 132 | 132 | } |
| 133 | 133 | |
| 134 | 134 |
| --- tools/cvs2fossil/lib/c2f_state.tcl | |
| +++ tools/cvs2fossil/lib/c2f_state.tcl | |
| @@ -122,12 +122,12 @@ | |
| 122 | WHERE type = 'table' |
| 123 | AND name = $name |
| 124 | ; |
| 125 | }]] |
| 126 | |
| 127 | if {$found} return |
| 128 | |
| 129 | trouble internal "The required table \"$name\" is not defined." |
| 130 | # Not reached |
| 131 | return |
| 132 | } |
| 133 | |
| 134 |
| --- tools/cvs2fossil/lib/c2f_state.tcl | |
| +++ tools/cvs2fossil/lib/c2f_state.tcl | |
| @@ -122,12 +122,12 @@ | |
| 122 | WHERE type = 'table' |
| 123 | AND name = $name |
| 124 | ; |
| 125 | }]] |
| 126 | |
| 127 | # No assert, would cause cycle in package dependencies |
| 128 | if {$found} return |
| 129 | trouble internal "The required table \"$name\" is not defined." |
| 130 | # Not reached |
| 131 | return |
| 132 | } |
| 133 | |
| 134 |
+2
-1
| --- tools/cvs2fossil/lib/log.tcl | ||
| +++ tools/cvs2fossil/lib/log.tcl | ||
| @@ -30,11 +30,12 @@ | ||
| 30 | 30 | # or equal the chosen verbosity. A message of verbosity 0 cannot |
| 31 | 31 | # be blocked. |
| 32 | 32 | |
| 33 | 33 | typemethod write {verbosity system text} { |
| 34 | 34 | if {$verbosity > $myloglevel} return |
| 35 | - uplevel #0 [linsert $mylogcmd end write [System $system] $text] | |
| 35 | + uplevel #0 [linsert $mylogcmd end write [System $system] \ | |
| 36 | + [uplevel 1 [list ::subst $text]]] | |
| 36 | 37 | return |
| 37 | 38 | } |
| 38 | 39 | |
| 39 | 40 | # Similar to write, especially in the handling of the verbosity, |
| 40 | 41 | # to drive progress displays. It signals that for some long |
| 41 | 42 |
| --- tools/cvs2fossil/lib/log.tcl | |
| +++ tools/cvs2fossil/lib/log.tcl | |
| @@ -30,11 +30,12 @@ | |
| 30 | # or equal the chosen verbosity. A message of verbosity 0 cannot |
| 31 | # be blocked. |
| 32 | |
| 33 | typemethod write {verbosity system text} { |
| 34 | if {$verbosity > $myloglevel} return |
| 35 | uplevel #0 [linsert $mylogcmd end write [System $system] $text] |
| 36 | return |
| 37 | } |
| 38 | |
| 39 | # Similar to write, especially in the handling of the verbosity, |
| 40 | # to drive progress displays. It signals that for some long |
| 41 |
| --- tools/cvs2fossil/lib/log.tcl | |
| +++ tools/cvs2fossil/lib/log.tcl | |
| @@ -30,11 +30,12 @@ | |
| 30 | # or equal the chosen verbosity. A message of verbosity 0 cannot |
| 31 | # be blocked. |
| 32 | |
| 33 | typemethod write {verbosity system text} { |
| 34 | if {$verbosity > $myloglevel} return |
| 35 | uplevel #0 [linsert $mylogcmd end write [System $system] \ |
| 36 | [uplevel 1 [list ::subst $text]]] |
| 37 | return |
| 38 | } |
| 39 | |
| 40 | # Similar to write, especially in the handling of the verbosity, |
| 41 | # to drive progress displays. It signals that for some long |
| 42 |