Overview
| SHA1 Hash: | 47d52d1efd967e4ee4f1159b822c175eefe96233 |
|---|---|
| Date: | 2007-11-28 05:39:49 |
| User: | aku |
| Comment: | 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. |
| Timelines: | ancestors | descendants | both | trunk |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- branch=trunk inherited from [a28c83647d]
- sym-trunk inherited from [a28c83647d]
Changes
[hide diffs]Modified tools/cvs2fossil/lib/c2f_file.tcl from [0e3e1e66e0] to [91fadc851a].
@@ -20,10 +20,11 @@
package require snit ; # OO system.
package require struct::set ; # Set operations.
package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions.
package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols.
package require vc::fossil::import::cvs::state ; # State storage.
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
package require vc::tools::trouble ; # Error reporting.
package require vc::tools::log ; # User feedback
package require vc::tools::misc ; # Text formatting
# # ## ### ##### ######## ############# #####################
@@ -42,11 +43,11 @@
set mytrunk [$myproject trunk]
return
}
method setid {id} {
- if {$myid ne ""} { trouble internal "File '$mypath' already has an id, '$myid'" }
+ integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'}
set myid $id
return
}
method id {} { return $myid }
@@ -325,13 +326,11 @@
}
return
}
method Rev2Branch {revnr} {
- if {[rev istrunkrevnr $revnr]} {
- trouble internal "Expected a branch revision number"
- }
+ integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number}
return $mybranches([rev 2branchnr $revnr])
}
method AddUnlabeledBranch {branchnr} {
return [$self AddBranch unlabeled-$branchnr $branchnr]
@@ -461,11 +460,11 @@
# simply take one revision and follow the parent links to
# their root (sic!).
foreach {revnr rev} [array get myrev] {
if {[$rev hasparent]} continue
- if {$myroot ne ""} { trouble internal "Multiple root revisions found" }
+ integrity assert {$myroot eq ""} {Multiple root revisions found}
set myroot $rev
}
# In the future we also need a list, as branches can become
# severed from their parent, making them their own root.
@@ -699,11 +698,11 @@
}
# Cut out the vendor branch symbol
set vendor [$first parentbranch]
- if {$vendor eq ""} { trouble internal "First NTDB revision has no branch" }
+ integrity assert {$vendor ne ""} {First NTDB revision has no branch}
if {[$vendor parent] eq $rev11} {
$rev11 removebranch $vendor
$rev11 removechildonbranch $first
$vendor cutchild
$first cutfromparentbranch
@@ -954,13 +953,13 @@
# should therefore not just be discarded even if
# --trunk-only.
if {[$root hasdefaultbranchchild]} {
set ntdbchild [$root defaultbranchchild]
- if {[$ntdbchild defaultbranchparent] ne $ntdbchild} {
- trouble internal "ntdb - trunk linkage broken"
- }
+ integrity assert {
+ [$ntdbchild defaultbranchparent] eq $ntdbchild
+ } {ntdb - trunk linkage broken}
$ntdbchild cutdefaultbranchparent
if {[$ntdbchild hasparent]} {
lappend myroots [$ntdbchild parent]
}
}
@@ -974,12 +973,12 @@
method GraftNTDB2Trunk {root} {
# We can now graft the non-trunk default branch revisions to
# trunk. They should already be alone on a CVSBranch-less
# branch.
- if {[$root hasparentbranch]} { trouble internal "NTDB root still has its branch symbol" }
- if {[$root hasbranches]} { trouble internal "NTDB root still has spawned branches" }
+ integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol}
+ integrity assert {![$root hasbranches]} {NTDB root still has spawned branches}
set last $root
while {[$last haschild]} {set last [$last child]}
if {[$last hasdefaultbranchchild]} {
@@ -1107,13 +1106,14 @@
# namespace import ::vc::fossil::import::cvs::file::sym
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::trouble
namespace import ::vc::tools::log
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::file 1.0
return
Modified tools/cvs2fossil/lib/c2f_frev.tcl from [0385926f22] to [72b07e1bd5].
@@ -17,10 +17,11 @@
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require vc::tools::misc ; # Text formatting
package require vc::fossil::import::cvs::state ; # State storage.
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::file::rev {
@@ -119,20 +120,20 @@
method hasparent {} { return [expr {$myparent ne ""}] }
method haschild {} { return [expr {$mychild ne ""}] }
method setparent {parent} {
- if {$myparent ne ""} { trouble internal "Parent already defined" }
+ integrity assert {$myparent eq ""} {Parent already defined}
set myparent $parent
return
}
method cutfromparent {} { set myparent "" ; return }
method cutfromchild {} { set mychild "" ; return }
method setchild {child} {
- if {$mychild ne ""} { trouble internal "Child already defined" }
+ integrity assert {$mychild eq ""} {Child already defined}
set mychild $child
return
}
method changeparent {parent} { set myparent $parent ; return }
@@ -142,11 +143,11 @@
method child {} { return $mychild }
# Branch linkage ______________________
method setparentbranch {branch} {
- if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" }
+ integrity assert {$myparentbranch eq ""} {Branch parent already defined}
set myparentbranch $branch
return
}
method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
@@ -519,13 +520,14 @@
namespace eval ::vc::fossil::import::cvs::file {
namespace export rev
namespace eval rev {
namespace import ::vc::tools::misc::*
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::file::rev 1.0
return
Modified tools/cvs2fossil/lib/c2f_fsym.tcl from [b29726a5a5] to [a9a75d2cd2].
@@ -18,10 +18,11 @@
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require vc::tools::trouble ; # Error reporting.
package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions.
package require vc::fossil::import::cvs::state ; # State storage.
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::file::sym {
@@ -33,14 +34,14 @@
set mytype $symtype
set mynr $nr
set mysymbol $symbol
switch -exact -- $mytype {
- branch { SetupBranch }
- tag { }
- default { trouble internal "Bad symbol type '$mytype'" }
+ branch { SetupBranch ; return }
+ tag { return }
}
+ integrity assert 0 {Bad symbol type '$mytype'}
return
}
method defid {} {
set myid [incr myidcounter]
@@ -113,11 +114,11 @@
method istrunk {} { return 0 }
# Branch acessor methods.
method setchildrevnr {revnr} {
- if {$mybranchchildrevnr ne ""} { trouble internal "Child already defined" }
+ integrity assert {$mybranchchildrevnr eq ""} {Child already defined}
set mybranchchildrevnr $revnr
return
}
method setposition {n} { set mybranchposition $n ; return }
@@ -284,14 +285,15 @@
namespace eval ::vc::fossil::import::cvs::file {
namespace export sym
namespace eval sym {
namespace import ::vc::fossil::import::cvs::file::rev
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
namespace import ::vc::tools::trouble
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::file::sym 1.0
return
Modified tools/cvs2fossil/lib/c2f_integrity.tcl from [19b5dfccf5] to [ef24788cd7].
@@ -27,10 +27,17 @@
snit::type ::vc::fossil::import::cvs::integrity {
# # ## ### ##### ######## #############
## Public API
+ typemethod assert {expression failmessage} {
+ set ok [uplevel 1 [list ::expr $expression]]
+ if {$ok} return
+ trouble internal [uplevel 1 [list ::subst $failmessage]]
+ return
+ }
+
typemethod strict {} {
log write 4 integrity {Check database consistency}
set n 0
AllButMeta
@@ -515,11 +522,11 @@
set ok 1
foreach {fname revnr} [state run $sql] {
set ok 0
trouble fatal "$fname <$revnr> $label"
}
- log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
+ log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
proc CheckCS {header label sql} {
upvar 1 n n
@@ -526,11 +533,11 @@
set ok 1
foreach {ctype cid} [state run $sql] {
set ok 0
trouble fatal "<$ctype $cid> $label"
}
- log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
+ log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
proc CheckInCS {header label sql} {
upvar 1 n n
@@ -538,11 +545,11 @@
foreach {cstype csid fname revnr} [state run $sql] {
set ok 0
set b "<$cstype $csid>"
trouble fatal "$fname <$revnr> [string map [list @ $b] $label]"
}
- log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
+ log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
# # ## ### ##### ######## #############
## Configuration
Modified tools/cvs2fossil/lib/c2f_pass.tcl from [0323a24545] to [b27a6e1d11].
@@ -15,29 +15,30 @@
## query this manager to dynamically create the relevant texts.
# # ## ### ##### ######## ############# #####################
## Requirements
-package require Tcl 8.4 ; # Required runtime.
-package require snit ; # OO system.
-package require vc::fossil::import::cvs::state ; # State storage
-package require vc::tools::misc ; # Text formatting
-package require vc::tools::trouble ; # Error reporting.
-package require vc::tools::log ; # User feedback.
-package require struct::list ; # Portable lassign
+package require Tcl 8.4 ; # Required runtime.
+package require snit ; # OO system.
+package require vc::fossil::import::cvs::state ; # State storage
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
+package require vc::tools::misc ; # Text formatting
+package require vc::tools::trouble ; # Error reporting.
+package require vc::tools::log ; # User feedback.
+package require struct::list ; # Portable lassign
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::pass {
# # ## ### ##### ######## #############
## Public API, Methods (Setup, query)
typemethod define {name description command} {
- if {[info exists mydesc($name)]} {
- trouble internal "Multiple definitions for pass code '$name'"
- }
+ integrity assert {
+ ![info exists mydesc($name)]
+ } {Multiple definitions for pass code '$name'}
lappend mypasses $name
set mydesc($name) $description
set mycmd($name) $command
return
}
@@ -197,10 +198,11 @@
namespace eval ::vc::fossil::import::cvs {
namespace export pass
namespace eval pass {
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::trouble
namespace import ::vc::tools::log
log register pass
}
Modified tools/cvs2fossil/lib/c2f_pbreakacycle.tcl from [7ef64f5370] to [143b6f64eb].
@@ -174,13 +174,13 @@
# At last check that the normal frament is indeed not
# backward, and iterate over the possibly still backward
# second fragment.
struct::list assign $replacements normal backward
- if {[IsBackward $graph $normal]} {
- trouble internal "The normal fragment is unexpectedly backward"
- }
+ integrity assert {
+ ![IsBackward $graph $normal]
+ } {The normal fragment is unexpectedly backward}
set cset $backward
}
return
}
@@ -259,14 +259,13 @@
# wrong.
foreach revision [array names limits] {
struct::list assign $limits($revision) maxp mins
# Handle min successor position "" as representing infinity
- if {$mins eq ""} continue
- if {$maxp < $mins} continue
-
- trouble internal "Branch revision $revision is backward at file level ($maxp >= $mins)"
+ integrity assert {
+ ($mins eq "") || ($maxp < $mins)
+ } {Branch revision $revision is backward at file level ($maxp >= $mins)}
}
# Save the limits for the splitter, and compute the border at
# which to split as the minimum of all minimal successor
# positions.
@@ -299,12 +298,12 @@
} else {
lappend normalrevisions $rev
}
}
- if {![llength $normalrevisions]} { trouble internal "Set of normal revisions is empty" }
- if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" }
+ integrity assert {[llength $normalrevisions]} {Set of normal revisions is empty}
+ integrity assert {[llength $backwardrevisions]} {Set of backward revisions is empty}
return
}
# # ## ### ##### ######## #############
@@ -369,11 +368,11 @@
} else {
::variable mycset
set old [$mycset($mylastpos) str]@$mylastpos
}
- trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old"
+ integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
}
set mylastpos $new
return
}
Modified tools/cvs2fossil/lib/c2f_pfiltersym.tcl from [ec9b1e0027] to [fad4c39f71].
@@ -380,11 +380,11 @@
set oldname $sx($lod)
struct::list assign $fpn($fid) fname prname
# Do the grafting.
- log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'"
+ log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'}
state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
incr n
}
log write 3 filtersym "Reparented [nsp $n tag]"
@@ -438,11 +438,11 @@
set oldname $sx($lod)
struct::list assign $fpn($fid) fname prname
# Do the grafting.
- log write 4 filtersym "\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'"
+ log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'}
state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
incr n
}
log write 3 filtersym "Reparented [nsp $n branch branches]"
Modified tools/cvs2fossil/lib/c2f_prev.tcl from [21310ece52] to [836578d137].
@@ -20,10 +20,11 @@
package require snit ; # OO system.
package require vc::tools::misc ; # Text formatting
package require vc::tools::trouble ; # Error reporting.
package require vc::tools::log ; # User feedback.
package require vc::fossil::import::cvs::state ; # State storage.
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
package require vc::fossil::import::cvs::project::sym ; # Project level symbols
# # ## ### ##### ######## ############# #####################
##
@@ -200,13 +201,13 @@
array set breaks {}
while {$at < [llength $pending]} {
set current [lindex $pending $at]
- log write 6 csets ". . .. ... ..... ........ ............."
- log write 6 csets "Scheduled [join [PRs [lrange $pending $at end]] { }]"
- log write 6 csets "Considering [PR $current] \[$at/[llength $pending]\]"
+ log write 6 csets {. . .. ... ..... ........ .............}
+ log write 6 csets {Scheduled [join [PRs [lrange $pending $at end]] { }]}
+ log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]}
set best [FindBestBreak $current]
if {$best < 0} {
# The inspected range has no internal
@@ -233,16 +234,12 @@
set fragbefore [lrange $current 0 $brel]
set fragafter [lrange $current $bnext end]
log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]"
- if {![llength $fragbefore]} {
- trouble internal "Tried to split off a zero-length fragment at the beginning"
- }
- if {![llength $fragafter]} {
- trouble internal "Tried to split off a zero-length fragment at the end"
- }
+ integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning}
+ integrity assert {[llength $fragafter]} {Found zero-length fragment at the end}
lappend pending $fragbefore $fragafter
CutAt $best
}
@@ -266,31 +263,27 @@
#puts \t.[join [PRs $fragments] .\n\t.].
Border [lindex $fragments 0] firsts firste
- if {$firsts != 0} {
- trouble internal "Bad fragment start @ $firsts, gap, or before beginning of the range"
- }
+ integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range}
set laste $firste
foreach fragment [lrange $fragments 1 end] {
Border $fragment s e
- if {$laste != ($s - 1)} {
- trouble internal "Bad fragment border <$laste | $s>, gap or overlap"
- }
+ integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap}
set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]]
log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"
set laste $e
}
- if {$laste != ([llength $myrevisions]-1)} {
- trouble internal "Bad fragment end @ $laste, gap, or beyond end of the range"
- }
+ integrity assert {
+ $laste == ([llength $myrevisions]-1)
+ } {Bad fragment end @ $laste, gap, or beyond end of the range}
# Put the first fragment into the current changeset, and
# update the in-memory index. We can simply (re)add the
# revisions because we cleared the previously existing
# information, see (*) above. Persistence does not matter
@@ -365,13 +358,13 @@
$cset drop
$cset destroy
set newcsets {}
foreach fragmentrevisions $args {
- if {![llength $fragmentrevisions]} {
- trouble internal "Attempted to create an empty changeset, i.e. without revisions"
- }
+ integrity assert {
+ [llength $fragmentrevisions]
+ } {Attempted to create an empty changeset, i.e. without revisions}
lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions]
}
foreach c $newcsets { $c persist }
return $newcsets
@@ -464,13 +457,11 @@
AND RA.rid = R.dbchild -- Go directly to trunk root
AND RA.child IS NOT NULL -- Has primary child.
AND RA.child IN $theset -- Which is also of interest
"] {
# Consider moving this to the integrity module.
- if {$rid == $child} {
- trouble internal "Revision $rid depends on itself."
- }
+ integrity assert {$rid != $child} {Revision $rid depends on itself.}
lappend dependencies($rid) $child
set dep($rid,$child) .
}
# The sql statements above looks only for direct dependencies
@@ -564,13 +555,11 @@
AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk
AND RA.rid = R.dbchild -- Go directly to trunk root
AND RA.child IS NOT NULL -- Has primary child.
"] {
# Consider moving this to the integrity module.
- if {$rid == $child} {
- trouble internal "Revision $rid depends on itself."
- }
+ integrity assert {$rid != $child} {Revision $rid depends on itself.}
lappend dependencies($rid) $child
}
return
}
@@ -611,13 +600,11 @@
AND R.parent IS NOT NULL -- which are not root
AND RA.rid = R.parent -- go to their parent
AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root
"] {
# Consider moving this to the integrity module.
- if {$rid == $parent} {
- trouble internal "Revision $rid depends on itself."
- }
+ integrity assert {$rid != $parent} {Revision $rid depends on itself.}
lappend dependencies($rid) $parent
}
return
}
@@ -860,10 +847,11 @@
namespace eval ::vc::fossil::import::cvs::project {
namespace export rev
namespace eval rev {
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::sym
}
::variable mybranchcode [project::sym branch]
namespace import ::vc::tools::misc::*
Modified tools/cvs2fossil/lib/c2f_prevlink.tcl from [3543c0875d] to [38dafe8989].
@@ -26,10 +26,11 @@
package require snit ; # OO system.
package require vc::tools::misc ; # Text formatting
package require vc::tools::trouble ; # Error reporting.
package require vc::tools::log ; # User feedback.
package require vc::fossil::import::cvs::state ; # State storage.
+package require vc::fossil::import::cvs::integrity ; # State integrity checks.
package require vc::fossil::import::cvs::project::rev ; # Project level changesets
# # ## ### ##### ######## ############# #####################
##
@@ -122,13 +123,11 @@
return 0 ; # Self is worse or equal, i.e. not better.
}
method break {} {
- if {![$self breakable]} {
- trouble internal "Changeset [$mycset str] is not breakable."
- }
+ integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.}
# One thing to choose when splitting CSET is where the
# revision in categories 1 and 2 (none and passthrough
# respectively) are moved to. This is done using the counters.
@@ -217,10 +216,11 @@
namespace eval ::vc::fossil::import::cvs::project {
namespace export revlink
namespace eval revlink {
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::fossil::import::cvs::integrity
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::trouble
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::rev
}
Modified tools/cvs2fossil/lib/c2f_psym.tcl from [c46d514b0d] to [46632d1874].
@@ -366,11 +366,11 @@
if {$mytagcount < $mybranchcount} { return $mybranch }
return $myundef
}
method MarkAs {label chosen} {
- log write 3 symbol "\[$label\] Converting symbol '$myname' as $mysymtype($chosen)"
+ log write 3 symbol {\[$label\] Converting symbol '$myname' as $mysymtype($chosen)}
set mytype $chosen
incr myrulecount($label)
# This is stored directly into the database.
Modified tools/cvs2fossil/lib/c2f_state.tcl from [027ea34f79] to [fe7e766e18].
@@ -122,12 +122,12 @@
WHERE type = 'table'
AND name = $name
;
}]]
- if {$found} return
-
+ # No assert, would cause cycle in package dependencies
+ if {$found} return
trouble internal "The required table \"$name\" is not defined."
# Not reached
return
}
Modified tools/cvs2fossil/lib/log.tcl from [d5c6c8a88e] to [875fe25bc7].
@@ -30,11 +30,12 @@
# or equal the chosen verbosity. A message of verbosity 0 cannot
# be blocked.
typemethod write {verbosity system text} {
if {$verbosity > $myloglevel} return
- uplevel #0 [linsert $mylogcmd end write [System $system] $text]
+ uplevel #0 [linsert $mylogcmd end write [System $system] \
+ [uplevel 1 [list ::subst $text]]]
return
}
# Similar to write, especially in the handling of the verbosity,
# to drive progress displays. It signals that for some long