|
94c39d6…
|
aku
|
1 |
## -*- tcl -*- |
|
94c39d6…
|
aku
|
2 |
# # ## ### ##### ######## ############# ##################### |
|
94c39d6…
|
aku
|
3 |
## Copyright (c) 2007 Andreas Kupries. |
|
94c39d6…
|
aku
|
4 |
# |
|
94c39d6…
|
aku
|
5 |
# This software is licensed as described in the file LICENSE, which |
|
94c39d6…
|
aku
|
6 |
# you should have received as part of this distribution. |
|
94c39d6…
|
aku
|
7 |
# |
|
94c39d6…
|
aku
|
8 |
# This software consists of voluntary contributions made by many |
|
94c39d6…
|
aku
|
9 |
# individuals. For exact contribution history, see the revision |
|
94c39d6…
|
aku
|
10 |
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
94c39d6…
|
aku
|
11 |
# # ## ### ##### ######## ############# ##################### |
|
94c39d6…
|
aku
|
12 |
|
|
94c39d6…
|
aku
|
13 |
## Helper class for the pass 6 cycle breaker. Each instance refers to |
|
94c39d6…
|
aku
|
14 |
## three changesets A, B, and C, with A a predecessor of B, and B |
|
94c39d6…
|
aku
|
15 |
## predecessor of C, and the whole part of a dependency cycle. |
|
94c39d6…
|
aku
|
16 |
|
|
94c39d6…
|
aku
|
17 |
## Instances analyse the file level dependencies which gave rise to |
|
94c39d6…
|
aku
|
18 |
## the changeset dependencies of A, B, and C, with the results used by |
|
94c39d6…
|
aku
|
19 |
## the cycle breaker algorithm to find a good location where to at |
|
94c39d6…
|
aku
|
20 |
## least weaken and at best fully break the cycle. |
|
94c39d6…
|
aku
|
21 |
|
|
94c39d6…
|
aku
|
22 |
# # ## ### ##### ######## ############# ##################### |
|
94c39d6…
|
aku
|
23 |
## Requirements |
|
94c39d6…
|
aku
|
24 |
|
|
94c39d6…
|
aku
|
25 |
package require Tcl 8.4 ; # Required runtime. |
|
94c39d6…
|
aku
|
26 |
package require snit ; # OO system. |
|
94c39d6…
|
aku
|
27 |
package require vc::tools::misc ; # Text formatting |
|
94c39d6…
|
aku
|
28 |
package require vc::tools::trouble ; # Error reporting. |
|
94c39d6…
|
aku
|
29 |
package require vc::tools::log ; # User feedback. |
|
94c39d6…
|
aku
|
30 |
package require vc::fossil::import::cvs::state ; # State storage. |
|
47d52d1…
|
aku
|
31 |
package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
|
94c39d6…
|
aku
|
32 |
package require vc::fossil::import::cvs::project::rev ; # Project level changesets |
|
94c39d6…
|
aku
|
33 |
|
|
94c39d6…
|
aku
|
34 |
# # ## ### ##### ######## ############# ##################### |
|
b679ca3…
|
aku
|
35 |
## |
|
94c39d6…
|
aku
|
36 |
|
|
94c39d6…
|
aku
|
37 |
snit::type ::vc::fossil::import::cvs::project::revlink { |
|
94c39d6…
|
aku
|
38 |
# # ## ### ##### ######## ############# |
|
94c39d6…
|
aku
|
39 |
## Public API |
|
94c39d6…
|
aku
|
40 |
|
|
94c39d6…
|
aku
|
41 |
constructor {prev cset next} { |
|
94c39d6…
|
aku
|
42 |
set myprev $prev |
|
94c39d6…
|
aku
|
43 |
set mycset $cset |
|
94c39d6…
|
aku
|
44 |
set mynext $next |
|
94c39d6…
|
aku
|
45 |
|
|
94c39d6…
|
aku
|
46 |
# We perform the bulk of the analysis during construction. The |
|
94c39d6…
|
aku
|
47 |
# file revisions held by the changeset CSET can be sorted into |
|
94c39d6…
|
aku
|
48 |
# four categories. |
|
94c39d6…
|
aku
|
49 |
|
|
94c39d6…
|
aku
|
50 |
# 1. Revisions whose predecessors are not in PREV, nor are |
|
94c39d6…
|
aku
|
51 |
# their successors found in NEXT. These revisions do not |
|
94c39d6…
|
aku
|
52 |
# count, as they did not induce any of the two dependencies |
|
94c39d6…
|
aku
|
53 |
# under consideration. They can be ignored. |
|
94c39d6…
|
aku
|
54 |
|
|
3c0ef2c…
|
aku
|
55 |
# 2. Revisions which have predecessors in PREV and successors |
|
94c39d6…
|
aku
|
56 |
# in NEXT. They are called 'passthrough' in cvs2svn. They |
|
94c39d6…
|
aku
|
57 |
# induce both dependencies under consideration and are thus |
|
94c39d6…
|
aku
|
58 |
# critical in the creation of the cycle. As such they are |
|
94c39d6…
|
aku
|
59 |
# also unbreakable :( |
|
94c39d6…
|
aku
|
60 |
|
|
94c39d6…
|
aku
|
61 |
# 3. Revisions which have predecessor in PREVE, but no |
|
94c39d6…
|
aku
|
62 |
# successors in NEXT. As such they induced the incoming |
|
94c39d6…
|
aku
|
63 |
# dependency, but not the outgoing one. |
|
94c39d6…
|
aku
|
64 |
|
|
94c39d6…
|
aku
|
65 |
# 4. Revisions which have no predecessors in PREVE, but their |
|
94c39d6…
|
aku
|
66 |
# successors are in NEXT. As such they induced the outgoing |
|
94c39d6…
|
aku
|
67 |
# dependency, but not the incoming one. |
|
94c39d6…
|
aku
|
68 |
|
|
94c39d6…
|
aku
|
69 |
# If we have no passthrough revisions then splitting the |
|
94c39d6…
|
aku
|
70 |
# changeset between categories 3 and 4, with category 1 going |
|
94c39d6…
|
aku
|
71 |
# wherever, will break the cycle. If category 2 revisions are |
|
94c39d6…
|
aku
|
72 |
# present we can still perform the split, this will however |
|
94c39d6…
|
aku
|
73 |
# not break the cycle, only weaken it. |
|
3c0ef2c…
|
aku
|
74 |
|
|
3c0ef2c…
|
aku
|
75 |
# NOTE: This is the only remaining user of 'nextmap'. Look |
|
3c0ef2c…
|
aku
|
76 |
# into the possibility of performing the relevant counting |
|
3c0ef2c…
|
aku
|
77 |
# within the database. |
|
4859304…
|
aku
|
78 |
|
|
94c39d6…
|
aku
|
79 |
array set csetprevmap [Invert [$myprev nextmap]] |
|
94c39d6…
|
aku
|
80 |
array set csetnextmap [$mycset nextmap] |
|
94c39d6…
|
aku
|
81 |
|
|
61829b0…
|
aku
|
82 |
set prevrev [$myprev items] |
|
61829b0…
|
aku
|
83 |
set nextrev [$mynext items] |
|
94c39d6…
|
aku
|
84 |
|
|
4859304…
|
aku
|
85 |
foreach item [$mycset items] { |
|
4859304…
|
aku
|
86 |
set rt [RT $item] |
|
94c39d6…
|
aku
|
87 |
incr mycount($rt) |
|
4859304…
|
aku
|
88 |
lappend mycategory($rt) $item |
|
94c39d6…
|
aku
|
89 |
} |
|
94c39d6…
|
aku
|
90 |
return |
|
94c39d6…
|
aku
|
91 |
} |
|
94c39d6…
|
aku
|
92 |
|
|
94c39d6…
|
aku
|
93 |
# Result is TRUE if and only breaking myset will do some good. |
|
94c39d6…
|
aku
|
94 |
method breakable {} { expr {$mycount(prev) || $mycount(next)} } |
|
94c39d6…
|
aku
|
95 |
method passcount {} { return $mycount(pass) } |
|
94c39d6…
|
aku
|
96 |
|
|
94c39d6…
|
aku
|
97 |
method linkstomove {} { |
|
94c39d6…
|
aku
|
98 |
# Return the number of revisions that would be moved should we |
|
94c39d6…
|
aku
|
99 |
# split the changeset. |
|
94c39d6…
|
aku
|
100 |
|
|
94c39d6…
|
aku
|
101 |
set n [min2 $mycount(prev) $mycount(next)] |
|
94c39d6…
|
aku
|
102 |
if {$n > 0 } { return $n } |
|
94c39d6…
|
aku
|
103 |
return [max2 $mycount(prev) $mycount(next)] |
|
94c39d6…
|
aku
|
104 |
} |
|
94c39d6…
|
aku
|
105 |
|
|
94c39d6…
|
aku
|
106 |
method betterthan {other} { |
|
94c39d6…
|
aku
|
107 |
set sbreak [$self breakable] |
|
94c39d6…
|
aku
|
108 |
set obreak [$other breakable] |
|
94c39d6…
|
aku
|
109 |
|
|
94c39d6…
|
aku
|
110 |
if {$sbreak && !$obreak} { return 1 } ; # self is better. |
|
94c39d6…
|
aku
|
111 |
if {!$sbreak && $obreak} { return 0 } ; # self is worse. |
|
94c39d6…
|
aku
|
112 |
|
|
94c39d6…
|
aku
|
113 |
# Equality. Look at the counters. |
|
94c39d6…
|
aku
|
114 |
# - Whichever has the lesser number of passthrough revisions |
|
94c39d6…
|
aku
|
115 |
# is better, as more can be split off, weakening the cycle |
|
94c39d6…
|
aku
|
116 |
# more. |
|
94c39d6…
|
aku
|
117 |
# - Whichever has less links to move is better. |
|
94c39d6…
|
aku
|
118 |
|
|
94c39d6…
|
aku
|
119 |
set opass [$other passcount] |
|
94c39d6…
|
aku
|
120 |
if {$mycount(pass) < $opass} { return 1 } ; # self is better. |
|
94c39d6…
|
aku
|
121 |
if {$mycount(pass) > $opass} { return 0 } ; # self is worse. |
|
94c39d6…
|
aku
|
122 |
|
|
94c39d6…
|
aku
|
123 |
set smove [$self linkstomove] |
|
94c39d6…
|
aku
|
124 |
set omove [$other linkstomove] |
|
94c39d6…
|
aku
|
125 |
|
|
94c39d6…
|
aku
|
126 |
if {$smove < $omove} { return 1 } ; # self is better. |
|
94c39d6…
|
aku
|
127 |
|
|
94c39d6…
|
aku
|
128 |
return 0 ; # Self is worse or equal, i.e. not better. |
|
94c39d6…
|
aku
|
129 |
} |
|
94c39d6…
|
aku
|
130 |
|
|
94c39d6…
|
aku
|
131 |
method break {} { |
|
47d52d1…
|
aku
|
132 |
integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.} |
|
94c39d6…
|
aku
|
133 |
|
|
94c39d6…
|
aku
|
134 |
# One thing to choose when splitting CSET is where the |
|
94c39d6…
|
aku
|
135 |
# revision in categories 1 and 2 (none and passthrough |
|
94c39d6…
|
aku
|
136 |
# respectively) are moved to. This is done using the counters. |
|
94c39d6…
|
aku
|
137 |
|
|
94c39d6…
|
aku
|
138 |
if {!$mycount(prev)} { |
|
94c39d6…
|
aku
|
139 |
# Nothing in category 3 => 1,2 go there, 4 the other. |
|
94c39d6…
|
aku
|
140 |
set mycategory(prev) [concat $mycategory(none) $mycategory(pass)] |
|
94c39d6…
|
aku
|
141 |
} elseif {!$mycount(next)} { |
|
94c39d6…
|
aku
|
142 |
# Nothing in category 4 => 1,2 go there, 3 the other. |
|
94c39d6…
|
aku
|
143 |
set mycategory(next) [concat $mycategory(none) $mycategory(pass)] |
|
94c39d6…
|
aku
|
144 |
} elseif {$mycount(prev) < $mycount(next)} { |
|
94c39d6…
|
aku
|
145 |
# Less predecessors than successors => 1,2 go to the |
|
94c39d6…
|
aku
|
146 |
# sucessors. |
|
94c39d6…
|
aku
|
147 |
set mycategory(next) [concat $mycategory(next) $mycategory(none) \ |
|
94c39d6…
|
aku
|
148 |
$mycategory(pass)] |
|
94c39d6…
|
aku
|
149 |
} else { |
|
94c39d6…
|
aku
|
150 |
# Less successors than predecessors => 1,2 go to the |
|
94c39d6…
|
aku
|
151 |
# predecessors. |
|
94c39d6…
|
aku
|
152 |
set mycategory(next) [concat $mycategory(next) $mycategory(none) \ |
|
94c39d6…
|
aku
|
153 |
$mycategory(pass)] |
|
94c39d6…
|
aku
|
154 |
} |
|
94c39d6…
|
aku
|
155 |
|
|
5920742…
|
aku
|
156 |
# We now have the revisions for the two fragments to be in the |
|
5920742…
|
aku
|
157 |
# (prev|next) elements of mycategory. |
|
5920742…
|
aku
|
158 |
|
|
5920742…
|
aku
|
159 |
return [project::rev split $mycset $mycategory(prev) $mycategory(next)] |
|
94c39d6…
|
aku
|
160 |
} |
|
94c39d6…
|
aku
|
161 |
|
|
94c39d6…
|
aku
|
162 |
# # ## ### ##### ######## ############# |
|
94c39d6…
|
aku
|
163 |
## State |
|
94c39d6…
|
aku
|
164 |
|
|
94c39d6…
|
aku
|
165 |
variable myprev {} ; # Reference to predecessor changeset in the link. |
|
94c39d6…
|
aku
|
166 |
variable mycset {} ; # Reference to the main changeset of the link. |
|
94c39d6…
|
aku
|
167 |
variable mynext {} ; # Reference to the successor changeset in the link. |
|
94c39d6…
|
aku
|
168 |
|
|
94c39d6…
|
aku
|
169 |
# Counters for the revision categories. |
|
94c39d6…
|
aku
|
170 |
variable mycount -array { |
|
94c39d6…
|
aku
|
171 |
none 0 |
|
94c39d6…
|
aku
|
172 |
prev 0 |
|
94c39d6…
|
aku
|
173 |
next 0 |
|
94c39d6…
|
aku
|
174 |
pass 0 |
|
94c39d6…
|
aku
|
175 |
} |
|
94c39d6…
|
aku
|
176 |
# Lists of revisions for the various categories |
|
94c39d6…
|
aku
|
177 |
variable mycategory -array { |
|
94c39d6…
|
aku
|
178 |
none {} |
|
94c39d6…
|
aku
|
179 |
prev {} |
|
94c39d6…
|
aku
|
180 |
next {} |
|
94c39d6…
|
aku
|
181 |
pass {} |
|
94c39d6…
|
aku
|
182 |
} |
|
94c39d6…
|
aku
|
183 |
|
|
94c39d6…
|
aku
|
184 |
# # ## ### ##### ######## ############# |
|
94c39d6…
|
aku
|
185 |
## Internal methods |
|
94c39d6…
|
aku
|
186 |
|
|
94c39d6…
|
aku
|
187 |
proc RT {r} { |
|
94c39d6…
|
aku
|
188 |
upvar 1 csetprevmap csetprevmap csetnextmap csetnextmap prevrev prevrev nextrev nextrev |
|
94c39d6…
|
aku
|
189 |
|
|
94c39d6…
|
aku
|
190 |
set inc [expr {[info exists csetprevmap($r)] |
|
94c39d6…
|
aku
|
191 |
? [struct::set size [struct::set intersect $csetprevmap($r) $prevrev]] |
|
94c39d6…
|
aku
|
192 |
: 0}] |
|
94c39d6…
|
aku
|
193 |
set out [expr {[info exists csetnextmap($r)] |
|
94c39d6…
|
aku
|
194 |
? [struct::set size [struct::set intersect $csetnextmap($r) $nextrev]] |
|
94c39d6…
|
aku
|
195 |
: 0}] |
|
94c39d6…
|
aku
|
196 |
|
|
94c39d6…
|
aku
|
197 |
if {$inc && $out} { return pass } |
|
94c39d6…
|
aku
|
198 |
if {$inc} { return prev } |
|
94c39d6…
|
aku
|
199 |
if {$out} { return next } |
|
94c39d6…
|
aku
|
200 |
return none |
|
94c39d6…
|
aku
|
201 |
} |
|
94c39d6…
|
aku
|
202 |
|
|
94c39d6…
|
aku
|
203 |
proc Invert {dict} { |
|
94c39d6…
|
aku
|
204 |
array set tmp {} |
|
94c39d6…
|
aku
|
205 |
foreach {k values} $dict { |
|
94c39d6…
|
aku
|
206 |
foreach v $values { lappend tmp($v) $k } |
|
94c39d6…
|
aku
|
207 |
} |
|
94c39d6…
|
aku
|
208 |
return [array get tmp] |
|
94c39d6…
|
aku
|
209 |
} |
|
94c39d6…
|
aku
|
210 |
|
|
94c39d6…
|
aku
|
211 |
# # ## ### ##### ######## ############# |
|
94c39d6…
|
aku
|
212 |
## Configuration |
|
94c39d6…
|
aku
|
213 |
|
|
94c39d6…
|
aku
|
214 |
pragma -hastypeinfo no ; # no type introspection |
|
94c39d6…
|
aku
|
215 |
pragma -hasinfo no ; # no object introspection |
|
94c39d6…
|
aku
|
216 |
pragma -simpledispatch yes ; # simple fast dispatch |
|
94c39d6…
|
aku
|
217 |
|
|
94c39d6…
|
aku
|
218 |
# # ## ### ##### ######## ############# |
|
94c39d6…
|
aku
|
219 |
} |
|
94c39d6…
|
aku
|
220 |
|
|
94c39d6…
|
aku
|
221 |
namespace eval ::vc::fossil::import::cvs::project { |
|
94c39d6…
|
aku
|
222 |
namespace export revlink |
|
94c39d6…
|
aku
|
223 |
namespace eval revlink { |
|
94c39d6…
|
aku
|
224 |
namespace import ::vc::fossil::import::cvs::state |
|
47d52d1…
|
aku
|
225 |
namespace import ::vc::fossil::import::cvs::integrity |
|
94c39d6…
|
aku
|
226 |
namespace import ::vc::tools::misc::* |
|
94c39d6…
|
aku
|
227 |
namespace import ::vc::tools::trouble |
|
94c39d6…
|
aku
|
228 |
namespace eval project { |
|
94c39d6…
|
aku
|
229 |
namespace import ::vc::fossil::import::cvs::project::rev |
|
94c39d6…
|
aku
|
230 |
} |
|
94c39d6…
|
aku
|
231 |
namespace import ::vc::tools::log |
|
94c39d6…
|
aku
|
232 |
log register csets |
|
94c39d6…
|
aku
|
233 |
} |
|
94c39d6…
|
aku
|
234 |
} |
|
94c39d6…
|
aku
|
235 |
|
|
94c39d6…
|
aku
|
236 |
# # ## ### ##### ######## ############# ##################### |
|
94c39d6…
|
aku
|
237 |
## Ready |
|
94c39d6…
|
aku
|
238 |
|
|
94c39d6…
|
aku
|
239 |
package provide vc::fossil::import::cvs::project::revlink 1.0 |
|
94c39d6…
|
aku
|
240 |
return |