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.

aku 2007-11-28 05:39 trunk
Commit 47d52d1efd967e4ee4f1159b822c175eefe96233
--- tools/cvs2fossil/lib/c2f_file.tcl
+++ tools/cvs2fossil/lib/c2f_file.tcl
@@ -20,10 +20,11 @@
2020
package require snit ; # OO system.
2121
package require struct::set ; # Set operations.
2222
package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions.
2323
package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols.
2424
package require vc::fossil::import::cvs::state ; # State storage.
25
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
2526
package require vc::tools::trouble ; # Error reporting.
2627
package require vc::tools::log ; # User feedback
2728
package require vc::tools::misc ; # Text formatting
2829
2930
# # ## ### ##### ######## ############# #####################
@@ -42,11 +43,11 @@
4243
set mytrunk [$myproject trunk]
4344
return
4445
}
4546
4647
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'}
4849
set myid $id
4950
return
5051
}
5152
5253
method id {} { return $myid }
@@ -325,13 +326,11 @@
325326
}
326327
return
327328
}
328329
329330
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}
333332
return $mybranches([rev 2branchnr $revnr])
334333
}
335334
336335
method AddUnlabeledBranch {branchnr} {
337336
return [$self AddBranch unlabeled-$branchnr $branchnr]
@@ -461,11 +460,11 @@
461460
# simply take one revision and follow the parent links to
462461
# their root (sic!).
463462
464463
foreach {revnr rev} [array get myrev] {
465464
if {[$rev hasparent]} continue
466
- if {$myroot ne ""} { trouble internal "Multiple root revisions found" }
465
+ integrity assert {$myroot eq ""} {Multiple root revisions found}
467466
set myroot $rev
468467
}
469468
470469
# In the future we also need a list, as branches can become
471470
# severed from their parent, making them their own root.
@@ -699,11 +698,11 @@
699698
}
700699
701700
# Cut out the vendor branch symbol
702701
703702
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}
705704
if {[$vendor parent] eq $rev11} {
706705
$rev11 removebranch $vendor
707706
$rev11 removechildonbranch $first
708707
$vendor cutchild
709708
$first cutfromparentbranch
@@ -954,13 +953,13 @@
954953
# should therefore not just be discarded even if
955954
# --trunk-only.
956955
957956
if {[$root hasdefaultbranchchild]} {
958957
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}
962961
$ntdbchild cutdefaultbranchparent
963962
if {[$ntdbchild hasparent]} {
964963
lappend myroots [$ntdbchild parent]
965964
}
966965
}
@@ -974,12 +973,12 @@
974973
method GraftNTDB2Trunk {root} {
975974
# We can now graft the non-trunk default branch revisions to
976975
# trunk. They should already be alone on a CVSBranch-less
977976
# branch.
978977
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}
981980
982981
set last $root
983982
while {[$last haschild]} {set last [$last child]}
984983
985984
if {[$last hasdefaultbranchchild]} {
@@ -1107,13 +1106,14 @@
11071106
# namespace import ::vc::fossil::import::cvs::file::sym
11081107
namespace import ::vc::tools::misc::*
11091108
namespace import ::vc::tools::trouble
11101109
namespace import ::vc::tools::log
11111110
namespace import ::vc::fossil::import::cvs::state
1111
+ namespace import ::vc::fossil::import::cvs::integrity
11121112
}
11131113
}
11141114
11151115
# # ## ### ##### ######## ############# #####################
11161116
## Ready
11171117
11181118
package provide vc::fossil::import::cvs::file 1.0
11191119
return
11201120
--- 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 @@
1717
1818
package require Tcl 8.4 ; # Required runtime.
1919
package require snit ; # OO system.
2020
package require vc::tools::misc ; # Text formatting
2121
package require vc::fossil::import::cvs::state ; # State storage.
22
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
2223
2324
# # ## ### ##### ######## ############# #####################
2425
##
2526
2627
snit::type ::vc::fossil::import::cvs::file::rev {
@@ -119,20 +120,20 @@
119120
120121
method hasparent {} { return [expr {$myparent ne ""}] }
121122
method haschild {} { return [expr {$mychild ne ""}] }
122123
123124
method setparent {parent} {
124
- if {$myparent ne ""} { trouble internal "Parent already defined" }
125
+ integrity assert {$myparent eq ""} {Parent already defined}
125126
set myparent $parent
126127
return
127128
}
128129
129130
method cutfromparent {} { set myparent "" ; return }
130131
method cutfromchild {} { set mychild "" ; return }
131132
132133
method setchild {child} {
133
- if {$mychild ne ""} { trouble internal "Child already defined" }
134
+ integrity assert {$mychild eq ""} {Child already defined}
134135
set mychild $child
135136
return
136137
}
137138
138139
method changeparent {parent} { set myparent $parent ; return }
@@ -142,11 +143,11 @@
142143
method child {} { return $mychild }
143144
144145
# Branch linkage ______________________
145146
146147
method setparentbranch {branch} {
147
- if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" }
148
+ integrity assert {$myparentbranch eq ""} {Branch parent already defined}
148149
set myparentbranch $branch
149150
return
150151
}
151152
152153
method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
@@ -519,13 +520,14 @@
519520
namespace eval ::vc::fossil::import::cvs::file {
520521
namespace export rev
521522
namespace eval rev {
522523
namespace import ::vc::tools::misc::*
523524
namespace import ::vc::fossil::import::cvs::state
525
+ namespace import ::vc::fossil::import::cvs::integrity
524526
}
525527
}
526528
527529
# # ## ### ##### ######## ############# #####################
528530
## Ready
529531
530532
package provide vc::fossil::import::cvs::file::rev 1.0
531533
return
532534
--- 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 @@
1818
package require Tcl 8.4 ; # Required runtime.
1919
package require snit ; # OO system.
2020
package require vc::tools::trouble ; # Error reporting.
2121
package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions.
2222
package require vc::fossil::import::cvs::state ; # State storage.
23
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
2324
2425
# # ## ### ##### ######## ############# #####################
2526
##
2627
2728
snit::type ::vc::fossil::import::cvs::file::sym {
@@ -33,14 +34,14 @@
3334
set mytype $symtype
3435
set mynr $nr
3536
set mysymbol $symbol
3637
3738
switch -exact -- $mytype {
38
- branch { SetupBranch }
39
- tag { }
40
- default { trouble internal "Bad symbol type '$mytype'" }
39
+ branch { SetupBranch ; return }
40
+ tag { return }
4141
}
42
+ integrity assert 0 {Bad symbol type '$mytype'}
4243
return
4344
}
4445
4546
method defid {} {
4647
set myid [incr myidcounter]
@@ -113,11 +114,11 @@
113114
method istrunk {} { return 0 }
114115
115116
# Branch acessor methods.
116117
117118
method setchildrevnr {revnr} {
118
- if {$mybranchchildrevnr ne ""} { trouble internal "Child already defined" }
119
+ integrity assert {$mybranchchildrevnr eq ""} {Child already defined}
119120
set mybranchchildrevnr $revnr
120121
return
121122
}
122123
123124
method setposition {n} { set mybranchposition $n ; return }
@@ -284,14 +285,15 @@
284285
namespace eval ::vc::fossil::import::cvs::file {
285286
namespace export sym
286287
namespace eval sym {
287288
namespace import ::vc::fossil::import::cvs::file::rev
288289
namespace import ::vc::fossil::import::cvs::state
290
+ namespace import ::vc::fossil::import::cvs::integrity
289291
namespace import ::vc::tools::trouble
290292
}
291293
}
292294
293295
# # ## ### ##### ######## ############# #####################
294296
## Ready
295297
296298
package provide vc::fossil::import::cvs::file::sym 1.0
297299
return
298300
--- 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 @@
2626
##
2727
2828
snit::type ::vc::fossil::import::cvs::integrity {
2929
# # ## ### ##### ######## #############
3030
## 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
+ }
3138
3239
typemethod strict {} {
3340
log write 4 integrity {Check database consistency}
3441
3542
set n 0
@@ -515,11 +522,11 @@
515522
set ok 1
516523
foreach {fname revnr} [state run $sql] {
517524
set ok 0
518525
trouble fatal "$fname <$revnr> $label"
519526
}
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}
521528
return
522529
}
523530
524531
proc CheckCS {header label sql} {
525532
upvar 1 n n
@@ -526,11 +533,11 @@
526533
set ok 1
527534
foreach {ctype cid} [state run $sql] {
528535
set ok 0
529536
trouble fatal "<$ctype $cid> $label"
530537
}
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}
532539
return
533540
}
534541
535542
proc CheckInCS {header label sql} {
536543
upvar 1 n n
@@ -538,11 +545,11 @@
538545
foreach {cstype csid fname revnr} [state run $sql] {
539546
set ok 0
540547
set b "<$cstype $csid>"
541548
trouble fatal "$fname <$revnr> [string map [list @ $b] $label]"
542549
}
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}
544551
return
545552
}
546553
547554
# # ## ### ##### ######## #############
548555
## Configuration
549556
--- 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
--- tools/cvs2fossil/lib/c2f_pass.tcl
+++ tools/cvs2fossil/lib/c2f_pass.tcl
@@ -15,29 +15,30 @@
1515
## query this manager to dynamically create the relevant texts.
1616
1717
# # ## ### ##### ######## ############# #####################
1818
## Requirements
1919
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
2728
2829
# # ## ### ##### ######## ############# #####################
2930
##
3031
3132
snit::type ::vc::fossil::import::cvs::pass {
3233
# # ## ### ##### ######## #############
3334
## Public API, Methods (Setup, query)
3435
3536
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'}
3940
lappend mypasses $name
4041
set mydesc($name) $description
4142
set mycmd($name) $command
4243
return
4344
}
@@ -197,10 +198,11 @@
197198
198199
namespace eval ::vc::fossil::import::cvs {
199200
namespace export pass
200201
namespace eval pass {
201202
namespace import ::vc::fossil::import::cvs::state
203
+ namespace import ::vc::fossil::import::cvs::integrity
202204
namespace import ::vc::tools::misc::*
203205
namespace import ::vc::tools::trouble
204206
namespace import ::vc::tools::log
205207
log register pass
206208
}
207209
--- 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 @@
174174
# At last check that the normal frament is indeed not
175175
# backward, and iterate over the possibly still backward
176176
# second fragment.
177177
178178
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}
182182
183183
set cset $backward
184184
}
185185
return
186186
}
@@ -259,14 +259,13 @@
259259
# wrong.
260260
261261
foreach revision [array names limits] {
262262
struct::list assign $limits($revision) maxp mins
263263
# 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)}
268267
}
269268
270269
# Save the limits for the splitter, and compute the border at
271270
# which to split as the minimum of all minimal successor
272271
# positions.
@@ -299,12 +298,12 @@
299298
} else {
300299
lappend normalrevisions $rev
301300
}
302301
}
303302
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}
306305
return
307306
}
308307
309308
310309
# # ## ### ##### ######## #############
@@ -369,11 +368,11 @@
369368
} else {
370369
::variable mycset
371370
set old [$mycset($mylastpos) str]@$mylastpos
372371
}
373372
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}
375374
}
376375
377376
set mylastpos $new
378377
return
379378
}
380379
--- 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 @@
380380
set oldname $sx($lod)
381381
struct::list assign $fpn($fid) fname prname
382382
383383
# Do the grafting.
384384
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'}
386386
state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
387387
incr n
388388
}
389389
390390
log write 3 filtersym "Reparented [nsp $n tag]"
@@ -438,11 +438,11 @@
438438
set oldname $sx($lod)
439439
struct::list assign $fpn($fid) fname prname
440440
441441
# Do the grafting.
442442
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'}
444444
state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
445445
incr n
446446
}
447447
448448
log write 3 filtersym "Reparented [nsp $n branch branches]"
449449
--- 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
--- tools/cvs2fossil/lib/c2f_prev.tcl
+++ tools/cvs2fossil/lib/c2f_prev.tcl
@@ -20,10 +20,11 @@
2020
package require snit ; # OO system.
2121
package require vc::tools::misc ; # Text formatting
2222
package require vc::tools::trouble ; # Error reporting.
2323
package require vc::tools::log ; # User feedback.
2424
package require vc::fossil::import::cvs::state ; # State storage.
25
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
2526
package require vc::fossil::import::cvs::project::sym ; # Project level symbols
2627
2728
# # ## ### ##### ######## ############# #####################
2829
##
2930
@@ -200,13 +201,13 @@
200201
array set breaks {}
201202
202203
while {$at < [llength $pending]} {
203204
set current [lindex $pending $at]
204205
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]\]}
208209
209210
set best [FindBestBreak $current]
210211
211212
if {$best < 0} {
212213
# The inspected range has no internal
@@ -233,16 +234,12 @@
233234
set fragbefore [lrange $current 0 $brel]
234235
set fragafter [lrange $current $bnext end]
235236
236237
log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]"
237238
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}
244241
245242
lappend pending $fragbefore $fragafter
246243
CutAt $best
247244
}
248245
@@ -266,31 +263,27 @@
266263
267264
#puts \t.[join [PRs $fragments] .\n\t.].
268265
269266
Border [lindex $fragments 0] firsts firste
270267
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}
274269
275270
set laste $firste
276271
foreach fragment [lrange $fragments 1 end] {
277272
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}
281274
282275
set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]]
283276
284277
log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"
285278
286279
set laste $e
287280
}
288281
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}
292285
293286
# Put the first fragment into the current changeset, and
294287
# update the in-memory index. We can simply (re)add the
295288
# revisions because we cleared the previously existing
296289
# information, see (*) above. Persistence does not matter
@@ -365,13 +358,13 @@
365358
$cset drop
366359
$cset destroy
367360
368361
set newcsets {}
369362
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}
373366
lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions]
374367
}
375368
376369
foreach c $newcsets { $c persist }
377370
return $newcsets
@@ -464,13 +457,11 @@
464457
AND RA.rid = R.dbchild -- Go directly to trunk root
465458
AND RA.child IS NOT NULL -- Has primary child.
466459
AND RA.child IN $theset -- Which is also of interest
467460
"] {
468461
# 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.}
472463
lappend dependencies($rid) $child
473464
set dep($rid,$child) .
474465
}
475466
476467
# The sql statements above looks only for direct dependencies
@@ -564,13 +555,11 @@
564555
AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk
565556
AND RA.rid = R.dbchild -- Go directly to trunk root
566557
AND RA.child IS NOT NULL -- Has primary child.
567558
"] {
568559
# 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.}
572561
lappend dependencies($rid) $child
573562
}
574563
return
575564
}
576565
@@ -611,13 +600,11 @@
611600
AND R.parent IS NOT NULL -- which are not root
612601
AND RA.rid = R.parent -- go to their parent
613602
AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root
614603
"] {
615604
# 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.}
619606
lappend dependencies($rid) $parent
620607
}
621608
return
622609
}
623610
@@ -860,10 +847,11 @@
860847
861848
namespace eval ::vc::fossil::import::cvs::project {
862849
namespace export rev
863850
namespace eval rev {
864851
namespace import ::vc::fossil::import::cvs::state
852
+ namespace import ::vc::fossil::import::cvs::integrity
865853
namespace eval project {
866854
namespace import ::vc::fossil::import::cvs::project::sym
867855
}
868856
::variable mybranchcode [project::sym branch]
869857
namespace import ::vc::tools::misc::*
870858
--- 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 @@
2626
package require snit ; # OO system.
2727
package require vc::tools::misc ; # Text formatting
2828
package require vc::tools::trouble ; # Error reporting.
2929
package require vc::tools::log ; # User feedback.
3030
package require vc::fossil::import::cvs::state ; # State storage.
31
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
3132
package require vc::fossil::import::cvs::project::rev ; # Project level changesets
3233
3334
# # ## ### ##### ######## ############# #####################
3435
##
3536
@@ -122,13 +123,11 @@
122123
123124
return 0 ; # Self is worse or equal, i.e. not better.
124125
}
125126
126127
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.}
130129
131130
# One thing to choose when splitting CSET is where the
132131
# revision in categories 1 and 2 (none and passthrough
133132
# respectively) are moved to. This is done using the counters.
134133
@@ -217,10 +216,11 @@
217216
218217
namespace eval ::vc::fossil::import::cvs::project {
219218
namespace export revlink
220219
namespace eval revlink {
221220
namespace import ::vc::fossil::import::cvs::state
221
+ namespace import ::vc::fossil::import::cvs::integrity
222222
namespace import ::vc::tools::misc::*
223223
namespace import ::vc::tools::trouble
224224
namespace eval project {
225225
namespace import ::vc::fossil::import::cvs::project::rev
226226
}
227227
--- 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 @@
366366
if {$mytagcount < $mybranchcount} { return $mybranch }
367367
return $myundef
368368
}
369369
370370
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)}
372372
373373
set mytype $chosen
374374
incr myrulecount($label)
375375
376376
# This is stored directly into the database.
377377
--- 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 @@
122122
WHERE type = 'table'
123123
AND name = $name
124124
;
125125
}]]
126126
127
+ # No assert, would cause cycle in package dependencies
127128
if {$found} return
128
-
129129
trouble internal "The required table \"$name\" is not defined."
130130
# Not reached
131131
return
132132
}
133133
134134
--- 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
--- tools/cvs2fossil/lib/log.tcl
+++ tools/cvs2fossil/lib/log.tcl
@@ -30,11 +30,12 @@
3030
# or equal the chosen verbosity. A message of verbosity 0 cannot
3131
# be blocked.
3232
3333
typemethod write {verbosity system text} {
3434
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]]]
3637
return
3738
}
3839
3940
# Similar to write, especially in the handling of the verbosity,
4041
# to drive progress displays. It signals that for some long
4142
--- 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

Keyboard Shortcuts

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