Fossil

Check-in [47d52d1e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
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.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:47d52d1efd967e4ee4f1159b822c175eefe96233
User & Date: aku 2007-11-28 05:39:49
Context
2007-11-28
08:35
Bugfix in FilterSym pass. Grafting branches operated on the tags table :( check-in: 8ce7ffff user: aku tags: trunk
05:39
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. check-in: 47d52d1e user: aku tags: trunk
2007-11-27
09:07
Modified to break all backward symbols, not only branches, removed the other custom circle breaking code, should not be needed any longer (See comments for proof). check-in: 6b520e7d user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tools/cvs2fossil/lib/c2f_file.tcl.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
...
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
...
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
...
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
...
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
....
1105
1106
1107
1108
1109
1110
1111

1112
1113
1114
1115
1116
1117
1118
1119

package require Tcl 8.4                             ; # Required runtime.
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::tools::trouble                  ; # Error reporting.
package require vc::tools::log                      ; # User feedback
package require vc::tools::misc                     ; # Text formatting

# # ## ### ##### ######## ############# #####################
##

................................................................................
	set myexecutable $executable
	set myproject    $project
	set mytrunk      [$myproject trunk]
	return
    }

    method setid {id} {
	if {$myid ne ""} { trouble internal "File '$mypath' already has an id, '$myid'" }
	set myid $id
	return
    }

    method id      {} { return $myid }
    method path    {} { return $mypath }
    method usrpath {} { return $myusrpath }
................................................................................

	    $branch setchildrevnr $branchrevnr
	}
	return
    }

    method Rev2Branch {revnr} {
	if {[rev istrunkrevnr $revnr]} {
	    trouble internal "Expected a branch revision number"
	}
	return $mybranches([rev 2branchnr $revnr])
    }

    method AddUnlabeledBranch {branchnr} {
	return [$self AddBranch unlabeled-$branchnr $branchnr]
    }

................................................................................
	# checking all revisions we ensure that we can detect and
	# report the case of multiple roots. Without that we could
	# 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" }
	    set myroot $rev
	}

	# In the future we also need a list, as branches can become
	# severed from their parent, making them their own root.
	set myroots [list $myroot]
	return
................................................................................
		$stop cutfromparent
		lappend myroots $stop ; # New root, after vendor branch
	    }

	    # Cut out the vendor branch symbol

	    set vendor [$first parentbranch]
	    if {$vendor eq ""} { trouble internal "First NTDB revision has no branch" }
	    if {[$vendor parent] eq $rev11} {
		$rev11 removebranch        $vendor
		$rev11 removechildonbranch $first
		$vendor cutchild
		$first cutfromparentbranch
		lappend myroots $first
	    }
................................................................................
	    # questionable whether this handling is correct, since the
	    # non-trunk default branch revisions affect trunk and
	    # 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"
		}
		$ntdbchild cutdefaultbranchparent
		if {[$ntdbchild hasparent]} {
		    lappend myroots [$ntdbchild parent]
		}
	    }

	    set root [$root child]
................................................................................
    }

    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" }

	set last $root
	while {[$last haschild]} {set last [$last child]}

	if {[$last hasdefaultbranchchild]} {

	    set rev12 [$last defaultbranchchild]
................................................................................
	# Import not required, already a child namespace.
	# namespace import ::vc::fossil::import::cvs::file::rev
	# 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

    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::file 1.0
return







>







 







|







 







|
<
<







 







|







 







|







 







|
|
|







 







|
|







 







>








18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
...
324
325
326
327
328
329
330
331


332
333
334
335
336
337
338
...
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
...
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
...
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
...
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
....
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119

package require Tcl 8.4                             ; # Required runtime.
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

# # ## ### ##### ######## ############# #####################
##

................................................................................
	set myexecutable $executable
	set myproject    $project
	set mytrunk      [$myproject trunk]
	return
    }

    method setid {id} {
	integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'}
	set myid $id
	return
    }

    method id      {} { return $myid }
    method path    {} { return $mypath }
    method usrpath {} { return $myusrpath }
................................................................................

	    $branch setchildrevnr $branchrevnr
	}
	return
    }

    method Rev2Branch {revnr} {
        integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number}


	return $mybranches([rev 2branchnr $revnr])
    }

    method AddUnlabeledBranch {branchnr} {
	return [$self AddBranch unlabeled-$branchnr $branchnr]
    }

................................................................................
	# checking all revisions we ensure that we can detect and
	# report the case of multiple roots. Without that we could
	# simply take one revision and follow the parent links to
	# their root (sic!).

	foreach {revnr rev} [array get myrev] {
	    if {[$rev hasparent]} continue
	    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.
	set myroots [list $myroot]
	return
................................................................................
		$stop cutfromparent
		lappend myroots $stop ; # New root, after vendor branch
	    }

	    # Cut out the vendor branch symbol

	    set vendor [$first parentbranch]
	    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
		lappend myroots $first
	    }
................................................................................
	    # questionable whether this handling is correct, since the
	    # non-trunk default branch revisions affect trunk and
	    # should therefore not just be discarded even if
	    # --trunk-only.

	    if {[$root hasdefaultbranchchild]} {
		set ntdbchild [$root defaultbranchchild]
		integrity assert {
		    [$ntdbchild defaultbranchparent] eq $ntdbchild
		} {ntdb - trunk linkage broken}
		$ntdbchild cutdefaultbranchparent
		if {[$ntdbchild hasparent]} {
		    lappend myroots [$ntdbchild parent]
		}
	    }

	    set root [$root child]
................................................................................
    }

    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.

	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]} {

	    set rev12 [$last defaultbranchchild]
................................................................................
	# Import not required, already a child namespace.
	# namespace import ::vc::fossil::import::cvs::file::rev
	# 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

Changes to tools/cvs2fossil/lib/c2f_frev.tcl.

15
16
17
18
19
20
21

22
23
24
25
26
27
28
...
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
...
517
518
519
520
521
522
523

524
525
526
527
528
529
530
531
# # ## ### ##### ######## ############# #####################
## Requirements

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.


# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::file::rev {
    # # ## ### ##### ######## #############
    ## Public API
................................................................................

    # Basic parent/child linkage __________

    method hasparent {} { return [expr {$myparent ne ""}] }
    method haschild  {} { return [expr {$mychild  ne ""}] }

    method setparent {parent} {
	if {$myparent ne ""} { trouble internal "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" }
	set mychild $child
	return
    }

    method changeparent {parent} { set myparent $parent ; return }
    method changechild  {child}  { set mychild  $child  ; return }

    method parent {} { return $myparent }
    method child  {} { return $mychild  }

    # Branch linkage ______________________

    method setparentbranch {branch} {
	if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" }
	set myparentbranch $branch
	return
    }

    method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
    method hasbranches     {} { return [llength $mybranches] }

................................................................................
}

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

    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::file::rev 1.0
return







>







 







|








|













|







 







>








15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
...
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
# # ## ### ##### ######## ############# #####################
## Requirements

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 {
    # # ## ### ##### ######## #############
    ## Public API
................................................................................

    # Basic parent/child linkage __________

    method hasparent {} { return [expr {$myparent ne ""}] }
    method haschild  {} { return [expr {$mychild  ne ""}] }

    method setparent {parent} {
	integrity assert {$myparent eq ""} {Parent already defined}
	set myparent $parent
	return
    }

    method cutfromparent {} { set myparent "" ; return }
    method cutfromchild  {} { set mychild  "" ; return }

    method setchild {child} {
	integrity assert {$mychild eq ""} {Child already defined}
	set mychild $child
	return
    }

    method changeparent {parent} { set myparent $parent ; return }
    method changechild  {child}  { set mychild  $child  ; return }

    method parent {} { return $myparent }
    method child  {} { return $mychild  }

    # Branch linkage ______________________

    method setparentbranch {branch} {
	integrity assert {$myparentbranch eq ""} {Branch parent already defined}
	set myparentbranch $branch
	return
    }

    method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
    method hasbranches     {} { return [llength $mybranches] }

................................................................................
}

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

Changes to tools/cvs2fossil/lib/c2f_fsym.tcl.

16
17
18
19
20
21
22

23
24
25
26
27
28
29
..
31
32
33
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
...
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
...
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
## Requirements

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.


# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::file::sym {
    # # ## ### ##### ######## #############
    ## Public API
................................................................................
    constructor {symtype nr symbol file} {
	set myfile   $file
	set mytype   $symtype
	set mynr     $nr
	set mysymbol $symbol

	switch -exact -- $mytype {
	    branch  { SetupBranch }
	    tag     { }
	    default { trouble internal "Bad symbol type '$mytype'" }
	}

	return
    }

    method defid {} {
	set myid [incr myidcounter]
	return
    }
................................................................................
    #

    method istrunk {} { return 0 }

    # Branch acessor methods.

    method setchildrevnr  {revnr} {
	if {$mybranchchildrevnr ne ""} { trouble internal "Child already defined" }
	set mybranchchildrevnr $revnr
	return
    }

    method setposition {n}   { set mybranchposition $n ; return }
    method setparent   {rev} { set mybranchparent $rev ; return }
    method setchild    {rev} { set mybranchchild  $rev ; return }
................................................................................
}

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::tools::trouble
    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::file::sym 1.0
return







>







 







|
|
<

>







 







|







 







>









16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
...
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
## Requirements

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 {
    # # ## ### ##### ######## #############
    ## Public API
................................................................................
    constructor {symtype nr symbol file} {
	set myfile   $file
	set mytype   $symtype
	set mynr     $nr
	set mysymbol $symbol

	switch -exact -- $mytype {
	    branch  { SetupBranch ; return }
	    tag     { return }

	}
	integrity assert 0 {Bad symbol type '$mytype'}
	return
    }

    method defid {} {
	set myid [incr myidcounter]
	return
    }
................................................................................
    #

    method istrunk {} { return 0 }

    # Branch acessor methods.

    method setchildrevnr  {revnr} {
	integrity assert {$mybranchchildrevnr eq ""} {Child already defined}
	set mybranchchildrevnr $revnr
	return
    }

    method setposition {n}   { set mybranchposition $n ; return }
    method setparent   {rev} { set mybranchparent $rev ; return }
    method setchild    {rev} { set mybranchchild  $rev ; return }
................................................................................
}

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

Changes to tools/cvs2fossil/lib/c2f_integrity.tcl.

24
25
26
27
28
29
30







31
32
33
34
35
36
37
...
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::integrity {
    # # ## ### ##### ######## #############
    ## Public API








    typemethod strict {} {
	log write 4 integrity {Check database consistency}

	set n 0
	AllButMeta
	Meta
................................................................................
    proc Check {header label sql} {
	upvar 1 n n
	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"
	return
    }

    proc CheckCS {header label sql} {
	upvar 1 n n
	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"
	return
    }

    proc CheckInCS {header label sql} {
	upvar 1 n n
	set ok 1
	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"
	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton







>
>
>
>
>
>
>







 







|










|











|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

# # ## ### ##### ######## ############# #####################
##

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
	Meta
................................................................................
    proc Check {header label sql} {
	upvar 1 n n
	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}
	return
    }

    proc CheckCS {header label sql} {
	upvar 1 n n
	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}
	return
    }

    proc CheckInCS {header label sql} {
	upvar 1 n n
	set ok 1
	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}
	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton

Changes to tools/cvs2fossil/lib/c2f_pass.tcl.

13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209
210
211
212
213
## Pass manager. All passes register here, with code, description, and
## callbacks (... setup, run, finalize). Option processing and help
## 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

# # ## ### ##### ######## ############# #####################
##

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'"
	}
	lappend mypasses $name
	set mydesc($name) $description
	set mycmd($name)  $command
	return
    }

    typemethod help {} {
................................................................................
    # # ## ### ##### ######## #############
}

namespace eval ::vc::fossil::import::cvs {
    namespace export pass
    namespace eval pass {
	namespace import ::vc::fossil::import::cvs::state

	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log
	log register pass
    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::pass 1.0
return







|
|
|
>
|
|
|
|









|
|
|







 







>












13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
## Pass manager. All passes register here, with code, description, and
## callbacks (... setup, run, finalize). Option processing and help
## 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::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} {
	integrity assert {
	    ![info exists mydesc($name)]
	} {Multiple definitions for pass code '$name'}
	lappend mypasses $name
	set mydesc($name) $description
	set mycmd($name)  $command
	return
    }

    typemethod help {} {
................................................................................
    # # ## ### ##### ######## #############
}

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
    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::pass 1.0
return

Changes to tools/cvs2fossil/lib/c2f_pbreakacycle.tcl.

172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
...
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
	    cyclebreaker replace $graph $cset $replacements

	    # 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"
	    }

	    set cset $backward
	}
	return
    }

    proc IsBackward {dg cset} {
................................................................................
	# Check that the ordering at the file level is correct. We
	# cannot have backward ordering per revision, or something is
	# 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)"
	}

	# Save the limits for the splitter, and compute the border at
	# which to split as the minimum of all minimal successor
	# positions.

	set thelimits [array get limits]
................................................................................
	    if {$maxp >= $border} {
		lappend backwardrevisions  $rev
	    } 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" }
	return
    }


    # # ## ### ##### ######## #############

    proc KeepOrder {graph at cset} {
................................................................................
	    if {$mylastpos < 0} {
		set old "<NONE>"
	    } else {
		::variable mycset
		set old [$mycset($mylastpos) str]@$mylastpos
	    }

	    trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old"
	}

	set mylastpos $new
	return
    }

    proc FormatTR {graph cset} {







|
|
|







 







|
|
<
|







 







|
|







 







|







172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
	    cyclebreaker replace $graph $cset $replacements

	    # 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
	    integrity assert {
		![IsBackward $graph $normal]
	    } {The normal fragment is unexpectedly backward}

	    set cset $backward
	}
	return
    }

    proc IsBackward {dg cset} {
................................................................................
	# Check that the ordering at the file level is correct. We
	# cannot have backward ordering per revision, or something is
	# wrong.

	foreach revision [array names limits] {
	    struct::list assign $limits($revision) maxp mins
	    # Handle min successor position "" as representing infinity
	    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.

	set thelimits [array get limits]
................................................................................
	    if {$maxp >= $border} {
		lappend backwardrevisions  $rev
	    } else {
		lappend normalrevisions $rev
	    }
	}

	integrity assert {[llength $normalrevisions]}   {Set of normal revisions is empty}
	integrity assert {[llength $backwardrevisions]} {Set of backward revisions is empty}
	return
    }


    # # ## ### ##### ######## #############

    proc KeepOrder {graph at cset} {
................................................................................
	    if {$mylastpos < 0} {
		set old "<NONE>"
	    } else {
		::variable mycset
		set old [$mycset($mylastpos) str]@$mylastpos
	    }

	    integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
	}

	set mylastpos $new
	return
    }

    proc FormatTR {graph cset} {

Changes to tools/cvs2fossil/lib/c2f_pfiltersym.tcl.

378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450

	    set tagname $sn($id)
	    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'"
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n tag]"

	log write 3 filtersym "Adjust branch parents"
................................................................................

	    set braname $sn($id)
	    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'"
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n branch branches]"
	return
    }







|







 







|







378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450

	    set tagname $sn($id)
	    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'}
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n tag]"

	log write 3 filtersym "Adjust branch parents"
................................................................................

	    set braname $sn($id)
	    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'}
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n branch branches]"
	return
    }

Changes to tools/cvs2fossil/lib/c2f_prev.tcl.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
...
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
...
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
363
364
365
366
367
368
369

370
371
372
373
374
375
376
377
378
379
...
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
...
858
859
860
861
862
863
864

865
866
867
868
869
870
871

package require Tcl 8.4                               ; # Required runtime.
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::project::sym ; # Project level symbols

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::project::rev {
    # # ## ### ##### ######## #############
................................................................................
	set pending   [list $range]
	set at        0
	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]\]"

	    set best [FindBestBreak $current]

	    if {$best < 0} {
		# The inspected range has no internal
		# dependencies. This is a complete fragment.
		lappend fragments $current
................................................................................
		set brel [expr {$best - [lindex $current 0]}]
		set bnext $brel ; incr bnext
		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"
		}

		lappend pending $fragbefore $fragafter
		CutAt $best
	    }

	    incr at
	}
................................................................................

	set fragments [lsort -index 0 -integer $fragments]

	#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"
	}

	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"
	    }

	    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"
	}

	# 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
	# here, none of the changesets has been saved to the
	# persistent state yet.
................................................................................
	struct::list assign [$cset data] project cstype cssrc

	$cset drop
	$cset destroy

	set newcsets {}
	foreach fragmentrevisions $args {

	    if {![llength $fragmentrevisions]} {
		trouble internal "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
    }

................................................................................
	    AND   R.isdefault             -- Restrict to NTDB
	    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.
            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."
	    }
	    lappend dependencies($rid) $child
	    set dep($rid,$child) .
	}

	# The sql statements above looks only for direct dependencies
	# between revision in the changeset. However due to the
	# vagaries of meta data it is possible for two revisions of
................................................................................
	    WHERE R.rid   IN $theset      -- Restrict to revisions of interest
	    AND   R.isdefault             -- Restrict to NTDB
	    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."
	    }
	    lappend dependencies($rid) $child
	}
	return
    }

    proc PullPredecessorRevisions {dv revisions} {
	upvar 1 $dv dependencies
................................................................................
	    WHERE R.rid IN $theset       -- Restrict to revisions of interest
	    AND NOT R.isdefault          -- not on NTDB
	    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."
	    }
	    lappend dependencies($rid) $parent
	}
	return
    }

    proc InitializeBreakState {revisions} {
	upvar 1 pos pos cross cross range range depc depc delta delta \
................................................................................
    # # ## ### ##### ######## #############
}

namespace eval ::vc::fossil::import::cvs::project {
    namespace export rev
    namespace eval rev {
	namespace import ::vc::fossil::import::cvs::state

	namespace eval project {
	    namespace import ::vc::fossil::import::cvs::project::sym
	}
	::variable mybranchcode [project::sym branch]
	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log







>







 







|
|
|







 







<
|
<
<
|
<







 







<
|
<




<
|
<








|
|
|







 







>
|
|
<







 







<
|
<







 







<
|
<







 







<
|
<







 







>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
...
232
233
234
235
236
237
238

239


240

241
242
243
244
245
246
247
...
261
262
263
264
265
266
267

268

269
270
271
272

273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
...
356
357
358
359
360
361
362
363
364
365

366
367
368
369
370
371
372
...
455
456
457
458
459
460
461

462

463
464
465
466
467
468
469
...
553
554
555
556
557
558
559

560

561
562
563
564
565
566
567
...
598
599
600
601
602
603
604

605

606
607
608
609
610
611
612
...
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859

package require Tcl 8.4                               ; # Required runtime.
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

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::project::rev {
    # # ## ### ##### ######## #############
................................................................................
	set pending   [list $range]
	set at        0
	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]\]}

	    set best [FindBestBreak $current]

	    if {$best < 0} {
		# The inspected range has no internal
		# dependencies. This is a complete fragment.
		lappend fragments $current
................................................................................
		set brel [expr {$best - [lindex $current 0]}]
		set bnext $brel ; incr bnext
		set fragbefore [lrange $current 0 $brel]
		set fragafter  [lrange $current $bnext end]

		log write 6 csets "New pieces  [PR $fragbefore] [PR $fragafter]"


		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
	    }

	    incr at
	}
................................................................................

	set fragments [lsort -index 0 -integer $fragments]

	#puts \t.[join [PRs $fragments] .\n\t.].

	Border [lindex $fragments 0] firsts firste


	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

	    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
	}

	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
	# here, none of the changesets has been saved to the
	# persistent state yet.
................................................................................
	struct::list assign [$cset data] project cstype cssrc

	$cset drop
	$cset destroy

	set newcsets {}
	foreach fragmentrevisions $args {
	    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
    }

................................................................................
	    AND   R.isdefault             -- Restrict to NTDB
	    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.
            AND   RA.child IN $theset     -- Which is also of interest
	"] {
	    # Consider moving this to the integrity module.

	    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
	# between revision in the changeset. However due to the
	# vagaries of meta data it is possible for two revisions of
................................................................................
	    WHERE R.rid   IN $theset      -- Restrict to revisions of interest
	    AND   R.isdefault             -- Restrict to NTDB
	    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.

	    integrity assert {$rid != $child} {Revision $rid depends on itself.}

	    lappend dependencies($rid) $child
	}
	return
    }

    proc PullPredecessorRevisions {dv revisions} {
	upvar 1 $dv dependencies
................................................................................
	    WHERE R.rid IN $theset       -- Restrict to revisions of interest
	    AND NOT R.isdefault          -- not on NTDB
	    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.

	    integrity assert {$rid != $parent} {Revision $rid depends on itself.}

	    lappend dependencies($rid) $parent
	}
	return
    }

    proc InitializeBreakState {revisions} {
	upvar 1 pos pos cross cross range range depc depc delta delta \
................................................................................
    # # ## ### ##### ######## #############
}

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::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log

Changes to tools/cvs2fossil/lib/c2f_prevlink.tcl.

24
25
26
27
28
29
30

31
32
33
34
35
36
37
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
215
216
217
218
219
220
221

222
223
224
225
226
227
228

package require Tcl 8.4                               ; # Required runtime.
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::project::rev ; # Project level changesets

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::project::revlink {
    # # ## ### ##### ######## #############
................................................................................

	if {$smove < $omove} { return 1 } ; # self is better.

	return 0 ; # Self is worse or equal, i.e. not better.
    }

    method break {} {
	if {![$self breakable]} {
	    trouble internal "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.

	if {!$mycount(prev)} {
	    # Nothing in category 3 => 1,2 go there, 4 the other.
................................................................................
    # # ## ### ##### ######## #############
}

namespace eval ::vc::fossil::import::cvs::project {
    namespace export revlink
    namespace eval revlink {
	namespace import ::vc::fossil::import::cvs::state

	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace eval project {
	    namespace import ::vc::fossil::import::cvs::project::rev
	}
	namespace import ::vc::tools::log
	log register csets







>







 







<
|
<







 







>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
...
121
122
123
124
125
126
127

128

129
130
131
132
133
134
135
...
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228

package require Tcl 8.4                               ; # Required runtime.
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

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::project::revlink {
    # # ## ### ##### ######## #############
................................................................................

	if {$smove < $omove} { return 1 } ; # self is better.

	return 0 ; # Self is worse or equal, i.e. not better.
    }

    method break {} {

	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.

	if {!$mycount(prev)} {
	    # Nothing in category 3 => 1,2 go there, 4 the other.
................................................................................
    # # ## ### ##### ######## #############
}

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
	}
	namespace import ::vc::tools::log
	log register csets

Changes to tools/cvs2fossil/lib/c2f_psym.tcl.

364
365
366
367
368
369
370
371
372
373
374
375
376
377
378

	if {$mytagcount > $mybranchcount} { return $mytag }
	if {$mytagcount < $mybranchcount} { return $mybranch }
	return $myundef
    }

    method MarkAs {label 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.
	state run {
	    UPDATE symbol







|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378

	if {$mytagcount > $mybranchcount} { return $mytag }
	if {$mytagcount < $mybranchcount} { return $mybranch }
	return $myundef
    }

    method MarkAs {label 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.
	state run {
	    UPDATE symbol

Changes to tools/cvs2fossil/lib/c2f_state.tcl.

120
121
122
123
124
125
126

127
128
129
130
131
132
133
134
135
	    SELECT name
	    FROM sqlite_master
	    WHERE type = 'table'
	    AND   name = $name
	    ;
	}]]


	if {$found} return

	trouble internal "The required table \"$name\" is not defined."
	# Not reached
	return
    }

    typemethod discard {name} {
	# Method for a user to remove outdated information from the







>

<







120
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
	    SELECT name
	    FROM sqlite_master
	    WHERE type = 'table'
	    AND   name = $name
	    ;
	}]]

	# No assert, would cause cycle in package dependencies
	if {$found} return

	trouble internal "The required table \"$name\" is not defined."
	# Not reached
	return
    }

    typemethod discard {name} {
	# Method for a user to remove outdated information from the

Changes to tools/cvs2fossil/lib/log.tcl.

28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
    # Write the message 'text' to log, for the named 'system'. The
    # message is written if and only if the message verbosity is less
    # 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]

	return
    }

    # Similar to write, especially in the handling of the verbosity,
    # to drive progress displays. It signals that for some long
    # running operation we are at tick 'n' of at most 'max' ticks. An
    # empty 'max' indicates an infinite progress display.







|
>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
    # Write the message 'text' to log, for the named 'system'. The
    # message is written if and only if the message verbosity is less
    # 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] \
	    [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
    # running operation we are at tick 'n' of at most 'max' ticks. An
    # empty 'max' indicates an infinite progress display.