Fossil SCM

Plugged memory leak in changeset destructor. Updated commentary. Reformatting of a few integrity checks for readability.

aku 2008-02-24 02:16 trunk
Commit 4b0f43fb2f97fe23378ac43ee71fe8b56daa152c
Parent 59b54efab51989b…
1 file changed +31 -28
~ tools/cvs2fossil/lib/c2f_prev.tcl
M tools/cvs2fossil/lib/c2f_prev.tcl
+31 -28
--- tools/cvs2fossil/lib/c2f_prev.tcl
+++ tools/cvs2fossil/lib/c2f_prev.tcl
@@ -48,29 +48,33 @@
4848
 set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype}
4949
 set mysrcid $srcid
5050
 set myitems $items
5151
 set mypos {} ; # Commit location is not known yet.
5252
53
+ foreach iid $items { lappend mytitems [list $cstype $iid] }
54
+
5355
 # Keep track of the generated changesets and of the inverse
5456
 # mapping from items to them.
5557
 lappend mychangesets $self
5658
 lappend mytchangesets($cstype) $self
5759
 set myidmap($myid) $self
58
- foreach iid $items { lappend mytitems [list $cstype $iid] }
5960
6061
 MapItems $cstype $items
6162
 return
6263
 }
6364
6465
 destructor {
65
- # The main thing is to keep track of the itemmap and remove
66
- # the object from it. The lists of changesets (mychangesets,
67
- # mytchangesets) are not maintained (= reduced), for the
68
- # moment. We may be able to get rid of this entirely, at least
69
- # for (de)construction and pass InitCSets.
66
+ # We may be able to get rid of this entirely, at least for
67
+ # (de)construction and pass InitCSets.
7068
7169
 UnmapItems $mytype $myitems
70
+ unset myidmap($myid)
71
+
72
+ set pos [lsearch -exact $mychangesets $self]
73
+ set mychangesets [lreplace $mychangesets $pos $pos]
74
+ set pos [lsearch -exact $mytchangesets($mytype) $self]
75
+ set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
7276
 return
7377
 }
7478
7579
 method str {} {
7680
 set str "<"
@@ -144,35 +148,25 @@
144148
145149
 method breakinternaldependencies {cv} {
146150
 upvar 1 $cv counter
147151
 log write 14 csets {[$self str] BID}
148152
 vc::tools::mem::mark
149
- ##
150
- ## NOTE: This method, maybe in conjunction with its caller
151
- ## seems to be a memory hog, especially for large
152
- ## changesets, with 'large' meaning to have a 'long list
153
- ## of items, several thousand'. Investigate where the
154
- ## memory is spent and then look for ways of rectifying
155
- ## the problem.
156
- ##
157
-
158
- # This method inspects the changesets for internal
159
- # dependencies. Nothing is done if there are no
160
- # such. Otherwise the changeset is split into a set of
161
- # fragments without internal dependencies, transforming the
153
+
154
+ # This method inspects the changeset, looking for internal
155
+ # dependencies. Nothing is done if there are no such.
156
+
157
+ # Otherwise the changeset is split into a set of fragments
158
+ # which have no internal dependencies, transforming the
162159
 # internal dependencies into external ones. The new changesets
163160
 # generated from the fragment information are added to the
164
- # list of all changesets.
161
+ # list of all changesets (by the caller).
165162
166
- # The code checks only successor dependencies, as this
167
- # automatically covers the predecessor dependencies as well (A
163
+ # The code checks only successor dependencies, as this auto-
164
+ # matically covers the predecessor dependencies as well (Any
168165
 # successor dependency a -> b is also a predecessor dependency
169166
 # b -> a).
170167
171
- # Array of dependencies (parent -> child). This is pulled from
172
- # the state, and limited to successors within the changeset.
173
-
174168
 array set breaks {}
175169
176170
 set fragments [BreakDirectDependencies $myitems breaks]
177171
178172
 if {![llength $fragments]} { return {} }
@@ -219,10 +213,11 @@
219213
 DELETE FROM cssuccessor WHERE cid = $myid;
220214
 }
221215
 }
222216
223217
 UnmapItems $mytype $myitems
218
+ unset myidmap($myid)
224219
225220
 set pos [lsearch -exact $mychangesets $self]
226221
 set mychangesets [lreplace $mychangesets $pos $pos]
227222
 set pos [lsearch -exact $mytchangesets($mytype) $self]
228223
 set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
@@ -653,22 +648,26 @@
653648
654649
 #puts \t.[join [PRs $fragments] .\n\t.].
655650
656651
 Border [lindex $fragments 0] firsts firste
657652
658
- integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range}
653
+ integrity assert {
654
+ $firsts == 0
655
+ } {Bad fragment start @ $firsts, gap, or before beginning of the range}
659656
660657
 set laste $firste
661658
 foreach fragment [lrange $fragments 1 end] {
662659
 Border $fragment s e
663
- integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap}
660
+ integrity assert {
661
+ $laste == ($s - 1)
662
+ } {Bad fragment border <$laste | $s>, gap or overlap}
664663
665664
 set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
666665
 lappend newcsets $new
667666
 incr counter
668667
669
- log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"
668
+ log write 4 csets {Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)}
670669
671670
 set laste $e
672671
 }
673672
674673
 integrity assert {
@@ -691,11 +690,15 @@
691690
 # # ## ### ##### ######## #############
692691
693692
 proc BreakDirectDependencies {theitems bv} {
694693
 upvar 1 mytypeobj mytypeobj self self $bv breaks
695694
695
+ # Array of dependencies (parent -> child). This is pulled from
696
+ # the state, and limited to successors within the changeset.
697
+
696698
 array set dependencies {}
699
+
697700
 $mytypeobj internalsuccessors dependencies $theitems
698701
 if {![array size dependencies]} {
699702
 return {}
700703
 } ; # Nothing to break.
701704
702705
--- tools/cvs2fossil/lib/c2f_prev.tcl
+++ tools/cvs2fossil/lib/c2f_prev.tcl
@@ -48,29 +48,33 @@
48 set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype}
49 set mysrcid $srcid
50 set myitems $items
51 set mypos {} ; # Commit location is not known yet.
52
 
 
53 # Keep track of the generated changesets and of the inverse
54 # mapping from items to them.
55 lappend mychangesets $self
56 lappend mytchangesets($cstype) $self
57 set myidmap($myid) $self
58 foreach iid $items { lappend mytitems [list $cstype $iid] }
59
60 MapItems $cstype $items
61 return
62 }
63
64 destructor {
65 # The main thing is to keep track of the itemmap and remove
66 # the object from it. The lists of changesets (mychangesets,
67 # mytchangesets) are not maintained (= reduced), for the
68 # moment. We may be able to get rid of this entirely, at least
69 # for (de)construction and pass InitCSets.
70
71 UnmapItems $mytype $myitems
 
 
 
 
 
 
72 return
73 }
74
75 method str {} {
76 set str "<"
@@ -144,35 +148,25 @@
144
145 method breakinternaldependencies {cv} {
146 upvar 1 $cv counter
147 log write 14 csets {[$self str] BID}
148 vc::tools::mem::mark
149 ##
150 ## NOTE: This method, maybe in conjunction with its caller
151 ## seems to be a memory hog, especially for large
152 ## changesets, with 'large' meaning to have a 'long list
153 ## of items, several thousand'. Investigate where the
154 ## memory is spent and then look for ways of rectifying
155 ## the problem.
156 ##
157
158 # This method inspects the changesets for internal
159 # dependencies. Nothing is done if there are no
160 # such. Otherwise the changeset is split into a set of
161 # fragments without internal dependencies, transforming the
162 # internal dependencies into external ones. The new changesets
163 # generated from the fragment information are added to the
164 # list of all changesets.
165
166 # The code checks only successor dependencies, as this
167 # automatically covers the predecessor dependencies as well (A
168 # successor dependency a -> b is also a predecessor dependency
169 # b -> a).
170
171 # Array of dependencies (parent -> child). This is pulled from
172 # the state, and limited to successors within the changeset.
173
174 array set breaks {}
175
176 set fragments [BreakDirectDependencies $myitems breaks]
177
178 if {![llength $fragments]} { return {} }
@@ -219,10 +213,11 @@
219 DELETE FROM cssuccessor WHERE cid = $myid;
220 }
221 }
222
223 UnmapItems $mytype $myitems
 
224
225 set pos [lsearch -exact $mychangesets $self]
226 set mychangesets [lreplace $mychangesets $pos $pos]
227 set pos [lsearch -exact $mytchangesets($mytype) $self]
228 set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
@@ -653,22 +648,26 @@
653
654 #puts \t.[join [PRs $fragments] .\n\t.].
655
656 Border [lindex $fragments 0] firsts firste
657
658 integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range}
 
 
659
660 set laste $firste
661 foreach fragment [lrange $fragments 1 end] {
662 Border $fragment s e
663 integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap}
 
 
664
665 set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
666 lappend newcsets $new
667 incr counter
668
669 log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"
670
671 set laste $e
672 }
673
674 integrity assert {
@@ -691,11 +690,15 @@
691 # # ## ### ##### ######## #############
692
693 proc BreakDirectDependencies {theitems bv} {
694 upvar 1 mytypeobj mytypeobj self self $bv breaks
695
 
 
 
696 array set dependencies {}
 
697 $mytypeobj internalsuccessors dependencies $theitems
698 if {![array size dependencies]} {
699 return {}
700 } ; # Nothing to break.
701
702
--- tools/cvs2fossil/lib/c2f_prev.tcl
+++ tools/cvs2fossil/lib/c2f_prev.tcl
@@ -48,29 +48,33 @@
48 set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype}
49 set mysrcid $srcid
50 set myitems $items
51 set mypos {} ; # Commit location is not known yet.
52
53 foreach iid $items { lappend mytitems [list $cstype $iid] }
54
55 # Keep track of the generated changesets and of the inverse
56 # mapping from items to them.
57 lappend mychangesets $self
58 lappend mytchangesets($cstype) $self
59 set myidmap($myid) $self
 
60
61 MapItems $cstype $items
62 return
63 }
64
65 destructor {
66 # We may be able to get rid of this entirely, at least for
67 # (de)construction and pass InitCSets.
 
 
 
68
69 UnmapItems $mytype $myitems
70 unset myidmap($myid)
71
72 set pos [lsearch -exact $mychangesets $self]
73 set mychangesets [lreplace $mychangesets $pos $pos]
74 set pos [lsearch -exact $mytchangesets($mytype) $self]
75 set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
76 return
77 }
78
79 method str {} {
80 set str "<"
@@ -144,35 +148,25 @@
148
149 method breakinternaldependencies {cv} {
150 upvar 1 $cv counter
151 log write 14 csets {[$self str] BID}
152 vc::tools::mem::mark
153
154 # This method inspects the changeset, looking for internal
155 # dependencies. Nothing is done if there are no such.
156
157 # Otherwise the changeset is split into a set of fragments
158 # which have no internal dependencies, transforming the
 
 
 
 
 
 
 
159 # internal dependencies into external ones. The new changesets
160 # generated from the fragment information are added to the
161 # list of all changesets (by the caller).
162
163 # The code checks only successor dependencies, as this auto-
164 # matically covers the predecessor dependencies as well (Any
165 # successor dependency a -> b is also a predecessor dependency
166 # b -> a).
167
 
 
 
168 array set breaks {}
169
170 set fragments [BreakDirectDependencies $myitems breaks]
171
172 if {![llength $fragments]} { return {} }
@@ -219,10 +213,11 @@
213 DELETE FROM cssuccessor WHERE cid = $myid;
214 }
215 }
216
217 UnmapItems $mytype $myitems
218 unset myidmap($myid)
219
220 set pos [lsearch -exact $mychangesets $self]
221 set mychangesets [lreplace $mychangesets $pos $pos]
222 set pos [lsearch -exact $mytchangesets($mytype) $self]
223 set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
@@ -653,22 +648,26 @@
648
649 #puts \t.[join [PRs $fragments] .\n\t.].
650
651 Border [lindex $fragments 0] firsts firste
652
653 integrity assert {
654 $firsts == 0
655 } {Bad fragment start @ $firsts, gap, or before beginning of the range}
656
657 set laste $firste
658 foreach fragment [lrange $fragments 1 end] {
659 Border $fragment s e
660 integrity assert {
661 $laste == ($s - 1)
662 } {Bad fragment border <$laste | $s>, gap or overlap}
663
664 set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
665 lappend newcsets $new
666 incr counter
667
668 log write 4 csets {Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)}
669
670 set laste $e
671 }
672
673 integrity assert {
@@ -691,11 +690,15 @@
690 # # ## ### ##### ######## #############
691
692 proc BreakDirectDependencies {theitems bv} {
693 upvar 1 mytypeobj mytypeobj self self $bv breaks
694
695 # Array of dependencies (parent -> child). This is pulled from
696 # the state, and limited to successors within the changeset.
697
698 array set dependencies {}
699
700 $mytypeobj internalsuccessors dependencies $theitems
701 if {![array size dependencies]} {
702 return {}
703 } ; # Nothing to break.
704
705

Keyboard Shortcuts

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