|
1
|
## -*- tcl -*- |
|
2
|
# # ## ### ##### ######## ############# ##################### |
|
3
|
## Copyright (c) 2007 Andreas Kupries. |
|
4
|
# |
|
5
|
# This software is licensed as described in the file LICENSE, which |
|
6
|
# you should have received as part of this distribution. |
|
7
|
# |
|
8
|
# This software consists of voluntary contributions made by many |
|
9
|
# individuals. For exact contribution history, see the revision |
|
10
|
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
11
|
# # ## ### ##### ######## ############# ##################### |
|
12
|
|
|
13
|
## Pass X. This is the final pass for breaking changeset dependency |
|
14
|
## cycles. The previous breaker passes (7 and 9) broke cycles covering |
|
15
|
## revision and symbol changesets, respectively. This pass now breaks |
|
16
|
## any remaining cycles, each of which has to contain at least one |
|
17
|
## revision and at least one symbol changeset. |
|
18
|
|
|
19
|
# # ## ### ##### ######## ############# ##################### |
|
20
|
## Requirements |
|
21
|
|
|
22
|
package require Tcl 8.4 ; # Required runtime. |
|
23
|
package require snit ; # OO system. |
|
24
|
package require struct::list ; # Higher order list operations. |
|
25
|
package require struct::set ; # Set operations. |
|
26
|
package require vc::tools::misc ; # Min, max. |
|
27
|
package require vc::tools::log ; # User feedback. |
|
28
|
package require vc::tools::trouble ; # Error reporting. |
|
29
|
package require vc::fossil::import::cvs::repository ; # Repository management. |
|
30
|
package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles. |
|
31
|
package require vc::fossil::import::cvs::state ; # State storage. |
|
32
|
package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
|
33
|
package require vc::fossil::import::cvs::project::rev ; # Project level changesets |
|
34
|
|
|
35
|
# # ## ### ##### ######## ############# ##################### |
|
36
|
## Register the pass with the management |
|
37
|
|
|
38
|
vc::fossil::import::cvs::pass define \ |
|
39
|
BreakAllCsetCycles \ |
|
40
|
{Break Remaining ChangeSet Dependency Cycles} \ |
|
41
|
::vc::fossil::import::cvs::pass::breakacycle |
|
42
|
|
|
43
|
# # ## ### ##### ######## ############# ##################### |
|
44
|
## |
|
45
|
|
|
46
|
snit::type ::vc::fossil::import::cvs::pass::breakacycle { |
|
47
|
# # ## ### ##### ######## ############# |
|
48
|
## Public API |
|
49
|
|
|
50
|
typemethod setup {} { |
|
51
|
# Define the names and structure of the persistent state of |
|
52
|
# this pass. |
|
53
|
|
|
54
|
state use revision |
|
55
|
state use tag |
|
56
|
state use branch |
|
57
|
state use symbol |
|
58
|
state use changeset |
|
59
|
state use csitem |
|
60
|
state use cssuccessor |
|
61
|
return |
|
62
|
} |
|
63
|
|
|
64
|
typemethod load {} { |
|
65
|
# Pass manager interface. Executed to load data computed by |
|
66
|
# this pass into memory when this pass is skipped instead of |
|
67
|
# executed. |
|
68
|
return |
|
69
|
} |
|
70
|
|
|
71
|
typemethod run {} { |
|
72
|
# Pass manager interface. Executed to perform the |
|
73
|
# functionality of the pass. |
|
74
|
|
|
75
|
set len [string length [project::rev num]] |
|
76
|
set myatfmt %${len}s |
|
77
|
incr len 12 |
|
78
|
set mycsfmt %${len}s |
|
79
|
|
|
80
|
cyclebreaker precmd [myproc BreakBackward] |
|
81
|
cyclebreaker savecmd [myproc KeepOrder] |
|
82
|
|
|
83
|
state transaction { |
|
84
|
LoadCommitOrder |
|
85
|
cyclebreaker run break-all [myproc Changesets] |
|
86
|
} |
|
87
|
|
|
88
|
repository printcsetstatistics |
|
89
|
integrity changesets |
|
90
|
return |
|
91
|
} |
|
92
|
|
|
93
|
typemethod discard {} { |
|
94
|
# Pass manager interface. Executed for all passes after the |
|
95
|
# run passes, to remove all data of this pass from the state, |
|
96
|
# as being out of date. |
|
97
|
return |
|
98
|
} |
|
99
|
|
|
100
|
# # ## ### ##### ######## ############# |
|
101
|
## Internal methods |
|
102
|
|
|
103
|
proc Changesets {} { |
|
104
|
log write 2 breakrcycle {Selecting all changesets} |
|
105
|
return [project::rev all] |
|
106
|
} |
|
107
|
|
|
108
|
proc LoadCommitOrder {} { |
|
109
|
::variable mycset |
|
110
|
::variable myrevisionchangesets |
|
111
|
|
|
112
|
log write 2 breakacycle {Loading revision commit order} |
|
113
|
|
|
114
|
set n 0 |
|
115
|
state transaction { |
|
116
|
state foreachrow { |
|
117
|
SELECT cid, pos FROM csorder |
|
118
|
} { |
|
119
|
log progress 2 breakacycle $n {} |
|
120
|
set cset [project::rev of $cid] |
|
121
|
$cset setpos $pos |
|
122
|
set mycset($pos) $cset |
|
123
|
lappend myrevisionchangesets $cset |
|
124
|
incr n |
|
125
|
} |
|
126
|
} |
|
127
|
return |
|
128
|
} |
|
129
|
|
|
130
|
# # ## ### ##### ######## ############# |
|
131
|
|
|
132
|
proc BreakBackward {graph} { |
|
133
|
# We go over all branch changesets, i.e. the changesets |
|
134
|
# created by the symbols which are translated as branches, and |
|
135
|
# break any which are 'backward', which means that they have |
|
136
|
# at least one incoming revision changeset which is committed |
|
137
|
# after at least one of the outgoing revision changesets, per |
|
138
|
# the order computed in pass 6. In "cvs2svn" this is called |
|
139
|
# "retrograde". |
|
140
|
|
|
141
|
set n 0 |
|
142
|
set max [llength [$graph nodes]] |
|
143
|
foreach cset [$graph nodes] { |
|
144
|
log progress 2 breakacycle $n $max ; incr n |
|
145
|
if {![$cset isbranch]} continue |
|
146
|
CheckAndBreakBackward $graph $cset |
|
147
|
} |
|
148
|
return |
|
149
|
} |
|
150
|
|
|
151
|
proc CheckAndBreakBackward {graph cset} { |
|
152
|
while {[IsBackward $graph $cset]} { |
|
153
|
# Knowing that the branch changeset is backward we now |
|
154
|
# look at the individual branches in the changeset and |
|
155
|
# determine which of them are responsible for the |
|
156
|
# overlap. This allows us to split them into two sets, one |
|
157
|
# of non-overlapping branches, and of overlapping |
|
158
|
# ones. Each set induces a new changeset, and the second |
|
159
|
# one may still be backward and in need of further |
|
160
|
# splitting. Hence the looping. |
|
161
|
|
|
162
|
# The border used for the split is the minimal commit |
|
163
|
# position among the minimal sucessor commit positions for |
|
164
|
# the branches in the changeset. We sort the file level |
|
165
|
# items based on there they sit relative to the border |
|
166
|
# into before and after the border. As the branches cannot |
|
167
|
# be backward at file level thos before the border cannot |
|
168
|
# generate a backward symbol changeset, however the |
|
169
|
# branches after may constitute another backward branch |
|
170
|
# with a new border. |
|
171
|
|
|
172
|
# limits : dict (revision -> list (max predecessor commit, min sucessor commit)) |
|
173
|
|
|
174
|
ComputeLimits $cset limits border |
|
175
|
|
|
176
|
log write 5 breakacycle "Breaking backward changeset [$cset str] using commit position $border as border" |
|
177
|
|
|
178
|
SplitItems $limits $border normalitems backwarditems |
|
179
|
|
|
180
|
set replacements [project::rev split $cset $normalitems $backwarditems] |
|
181
|
cyclebreaker replace $graph $cset $replacements |
|
182
|
|
|
183
|
# At last we check that the normal frament is indeed not |
|
184
|
# backward, and iterate over the possibly still backward |
|
185
|
# second fragment. |
|
186
|
|
|
187
|
struct::list assign $replacements normal backward |
|
188
|
integrity assert { |
|
189
|
![IsBackward $graph $normal] |
|
190
|
} {The normal fragment is unexpectedly backward} |
|
191
|
|
|
192
|
set cset $backward |
|
193
|
} |
|
194
|
return |
|
195
|
} |
|
196
|
|
|
197
|
proc IsBackward {dg cset} { |
|
198
|
# A branch is "backward" if it has at least one incoming |
|
199
|
# revision changeset which is committed after at least one of |
|
200
|
# the outgoing revision changesets, per the order computed by |
|
201
|
# pass 6. |
|
202
|
|
|
203
|
# Rephrased, the maximal commit position found among the |
|
204
|
# incoming revision changesets is larger than the minimal |
|
205
|
# commit position found among the outgoing revision |
|
206
|
# changesets. Assuming that we have both incoming and outgoing |
|
207
|
# revision changesets for the branch. |
|
208
|
|
|
209
|
# The helper "Positions" computes the set of commit positions |
|
210
|
# for a set of changesets, which can be a mix of revision and |
|
211
|
# symbol changesets. |
|
212
|
|
|
213
|
set predecessors [Positions [$dg nodes -in $cset]] |
|
214
|
set successors [Positions [$dg nodes -out $cset]] |
|
215
|
|
|
216
|
return [expr { |
|
217
|
[llength $predecessors] && |
|
218
|
[llength $successors] && |
|
219
|
([max $predecessors] >= [min $successors]) |
|
220
|
}] |
|
221
|
} |
|
222
|
|
|
223
|
proc Positions {changesets} { |
|
224
|
# To compute the set of commit positions from the set of |
|
225
|
# changesets we first map each changeset to its position (*) |
|
226
|
# and then filter out the invalid responses (the empty string) |
|
227
|
# returned by the symbol changesets. |
|
228
|
# |
|
229
|
# (*) This data was loaded into memory earlir in the pass, by |
|
230
|
# LoadCommitOrder. |
|
231
|
|
|
232
|
return [struct::list filter [struct::list map $changesets \ |
|
233
|
[myproc ToPosition]] \ |
|
234
|
[myproc ValidPosition]] |
|
235
|
} |
|
236
|
|
|
237
|
proc ToPosition {cset} { $cset pos } |
|
238
|
proc ValidPosition {pos} { expr {$pos ne ""} } |
|
239
|
|
|
240
|
proc ComputeLimits {cset lv bv} { |
|
241
|
upvar 1 $lv thelimits $bv border |
|
242
|
|
|
243
|
# Individual branches may not have revision changesets which |
|
244
|
# are their predecessors and/or successors, leaving the limits |
|
245
|
# partially or completely undefined. To overcome this |
|
246
|
# initialize boundaries for all items with proper defaults (-1 |
|
247
|
# for max, {} for min, representing +infinity). |
|
248
|
|
|
249
|
array set maxpa {} |
|
250
|
array set minsa {} |
|
251
|
foreach item [$cset items] { |
|
252
|
set maxpa($item) -1 |
|
253
|
set minsa($item) {} |
|
254
|
} |
|
255
|
|
|
256
|
# Get the limits from the database, for the items which |
|
257
|
# actually have such, and merge the information with the |
|
258
|
# defaults. |
|
259
|
|
|
260
|
struct::list assign [$cset limits] maxpdict minsdict |
|
261
|
|
|
262
|
array set maxpa $maxpdict |
|
263
|
array set minsa $minsdict |
|
264
|
|
|
265
|
# Check that the ordering at the file level is correct. We |
|
266
|
# cannot have backward ordering per branch, or something is |
|
267
|
# wrong. |
|
268
|
|
|
269
|
foreach item [array names limits] { |
|
270
|
set mins $minsa($item) |
|
271
|
set maxp $maxp($item) |
|
272
|
# Note that for the min successor position "" represents |
|
273
|
# +infinity |
|
274
|
integrity assert { |
|
275
|
($mins eq "") || ($maxp < $mins) |
|
276
|
} {Item <$item> is backward at file level ($maxp >= $mins)} |
|
277
|
} |
|
278
|
|
|
279
|
# Save the limits for the splitter, and compute the border at |
|
280
|
# which to split as the minimum of all minimal successor |
|
281
|
# positions. |
|
282
|
|
|
283
|
# Compute the border at which to split as the minimum of all |
|
284
|
# minimal successor positions. By using the database info we |
|
285
|
# automatically/implicitly filter out anything without a min |
|
286
|
# successor. Further the data going into the comparison with |
|
287
|
# the border is put together. |
|
288
|
|
|
289
|
set border [min [Values $minsdict]] |
|
290
|
set thelimits [array get maxpa] |
|
291
|
return |
|
292
|
} |
|
293
|
|
|
294
|
proc Values {dict} { |
|
295
|
set res {} |
|
296
|
foreach {k v} $dict { lappend res $v } |
|
297
|
return $res |
|
298
|
} |
|
299
|
|
|
300
|
proc SplitItems {limits border nv bv} { |
|
301
|
upvar 1 $nv normalitems $bv backwarditems |
|
302
|
|
|
303
|
set normalitems {} |
|
304
|
set backwarditems {} |
|
305
|
|
|
306
|
foreach {item maxp} $limits { |
|
307
|
if {$maxp >= $border} { |
|
308
|
lappend backwarditems $item |
|
309
|
} else { |
|
310
|
lappend normalitems $item |
|
311
|
} |
|
312
|
} |
|
313
|
|
|
314
|
integrity assert {[llength $normalitems]} {Set of normal items is empty} |
|
315
|
integrity assert {[llength $backwarditems]} {Set of backward items is empty} |
|
316
|
return |
|
317
|
} |
|
318
|
|
|
319
|
# # ## ### ##### ######## ############# |
|
320
|
|
|
321
|
proc KeepOrder {graph at cset} { |
|
322
|
::variable myatfmt |
|
323
|
::variable mycsfmt |
|
324
|
|
|
325
|
set cid [$cset id] |
|
326
|
|
|
327
|
log write 8 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>" |
|
328
|
|
|
329
|
# We see here a mixture of symbol and revision changesets. |
|
330
|
# The symbol changesets are ignored as irrelevant. |
|
331
|
|
|
332
|
if {[$cset pos] eq ""} return |
|
333
|
|
|
334
|
# For the revision changesets we are sure that they are |
|
335
|
# consumed in the same order as generated by pass 7 |
|
336
|
# (RevTopologicalSort). Per the code in cvs2svn. |
|
337
|
|
|
338
|
# This works if and only if none of the symbol changesets are |
|
339
|
# "backwards", hence our breaking of the backward changesets |
|
340
|
# first, in the pre-hook. |
|
341
|
|
|
342
|
# Note that tag changesets cannot be backward as they don't |
|
343
|
# have successors at all. |
|
344
|
|
|
345
|
# An interesting thing IMHO, is that after breaking the |
|
346
|
# backward symbol changesets we should not have any circles |
|
347
|
# any longer. Each circle which would still be present has to |
|
348
|
# involve a backward symbol, and we split them all, so there |
|
349
|
# can't be a circle.. |
|
350
|
|
|
351
|
# Proof: |
|
352
|
# Let us assume we that have a circle |
|
353
|
# C: R1 -> ... -> Rx -> S -> Ry -> ... -> Rn -> R1 |
|
354
|
# Let us further assume that the symbol changeset S in that |
|
355
|
# circle is not backward. That means ORD(Rx) < ORD(Ry). The |
|
356
|
# earlier topological sorting without symbols now forces this |
|
357
|
# relationship through to be ORD(Rx) < ORD(R1) < ORD(Rx). We |
|
358
|
# have reached an impossibility, a paradox. Our initial |
|
359
|
# assumption of S not being backward cannot hold. |
|
360
|
# |
|
361
|
# Alternate, direct, reasoning: Without S the chain of |
|
362
|
# dependencies is Ry -> .. -> R1 -> .. -> Rx, therefore |
|
363
|
# ORD(Ry) < ORD(Rx) holds, and this means S is backward. |
|
364
|
|
|
365
|
struct::set exclude myrevisionchangesets $cset |
|
366
|
|
|
367
|
::variable mylastpos |
|
368
|
set new [$cset pos] |
|
369
|
|
|
370
|
if {$new != ($mylastpos + 1)} { |
|
371
|
if {$mylastpos < 0} { |
|
372
|
set old "<NONE>" |
|
373
|
} else { |
|
374
|
::variable mycset |
|
375
|
set old [$mycset($mylastpos) str]@$mylastpos |
|
376
|
} |
|
377
|
|
|
378
|
#integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old} |
|
379
|
log write 2 breakacycle {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old} |
|
380
|
} |
|
381
|
|
|
382
|
set mylastpos $new |
|
383
|
return |
|
384
|
} |
|
385
|
|
|
386
|
proc FormatTR {graph cset} { |
|
387
|
return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }] |
|
388
|
} |
|
389
|
|
|
390
|
typevariable mylastpos -1 ; # Position of last revision changeset saved. |
|
391
|
typevariable myrevisionchangesets {} ; # Set of revision changesets |
|
392
|
|
|
393
|
typevariable myatfmt ; # Format for log output to gain better alignment of the various columns. |
|
394
|
typevariable mycsfmt ; # Ditto for the changesets. |
|
395
|
|
|
396
|
# # ## ### ##### ######## ############# |
|
397
|
|
|
398
|
typevariable mycset -array {} ; # Map from commit positions to the |
|
399
|
# changeset (object ref) at that |
|
400
|
# position. |
|
401
|
|
|
402
|
# # ## ### ##### ######## ############# |
|
403
|
## Configuration |
|
404
|
|
|
405
|
pragma -hasinstances no ; # singleton |
|
406
|
pragma -hastypeinfo no ; # no introspection |
|
407
|
pragma -hastypedestroy no ; # immortal |
|
408
|
|
|
409
|
# # ## ### ##### ######## ############# |
|
410
|
} |
|
411
|
|
|
412
|
namespace eval ::vc::fossil::import::cvs::pass { |
|
413
|
namespace export breakacycle |
|
414
|
namespace eval breakacycle { |
|
415
|
namespace import ::vc::fossil::import::cvs::cyclebreaker |
|
416
|
namespace import ::vc::fossil::import::cvs::repository |
|
417
|
namespace import ::vc::fossil::import::cvs::state |
|
418
|
namespace import ::vc::fossil::import::cvs::integrity |
|
419
|
namespace eval project { |
|
420
|
namespace import ::vc::fossil::import::cvs::project::rev |
|
421
|
} |
|
422
|
namespace import ::vc::tools::misc::* |
|
423
|
namespace import ::vc::tools::trouble |
|
424
|
namespace import ::vc::tools::log |
|
425
|
log register breakacycle |
|
426
|
} |
|
427
|
} |
|
428
|
|
|
429
|
# # ## ### ##### ######## ############# ##################### |
|
430
|
## Ready |
|
431
|
|
|
432
|
package provide vc::fossil::import::cvs::pass::breakacycle 1.0 |
|
433
|
return |
|
434
|
|