84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Copyright (c) 2007 Andreas Kupries. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software is licensed as described in the file LICENSE, which 84de38d73f 2007-10-10 aku: # you should have received as part of this distribution. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software consists of voluntary contributions made by many 84de38d73f 2007-10-10 aku: # individuals. For exact contribution history, see the revision 84de38d73f 2007-10-10 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: ## Revisions per project, aka Changesets. These objects are first used 5f7acef887 2007-11-10 aku: ## in pass 5, which creates the initial set covering the repository. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Requirements 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: package require Tcl 8.4 ; # Required runtime. 5f7acef887 2007-11-10 aku: package require snit ; # OO system. 08ebab80cd 2007-11-10 aku: package require vc::tools::misc ; # Text formatting 08ebab80cd 2007-11-10 aku: package require vc::tools::trouble ; # Error reporting. 95af789e1f 2007-11-10 aku: package require vc::tools::log ; # User feedback. 5f7acef887 2007-11-10 aku: package require vc::fossil::import::cvs::state ; # State storage. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: snit::type ::vc::fossil::import::cvs::project::rev { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: constructor {project cstype srcid revisions} { 5f7acef887 2007-11-10 aku: set myid [incr mycounter] 5f7acef887 2007-11-10 aku: set myproject $project 5f7acef887 2007-11-10 aku: set mytype $cstype 5f7acef887 2007-11-10 aku: set mysrcid $srcid 5f7acef887 2007-11-10 aku: set myrevisions $revisions 5f7acef887 2007-11-10 aku: return 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: method id {} { return $myid } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: method breakinternaldependencies {cv} { 95af789e1f 2007-11-10 aku: upvar 2 $cv csets ; # simple-dispatch! 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # This method inspects the changesets for internal 95af789e1f 2007-11-10 aku: # dependencies. Nothing is done if there are no 95af789e1f 2007-11-10 aku: # such. Otherwise the changeset is split into a set of 95af789e1f 2007-11-10 aku: # fragments without internal dependencies, transforming the 95af789e1f 2007-11-10 aku: # internal dependencies into external ones. The new changesets 95af789e1f 2007-11-10 aku: # are added to the list of all changesets. 95af789e1f 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # We perform all necessary splits in one go, instead of only 08ebab80cd 2007-11-10 aku: # one. The previous algorithm, adapted from cvs2svn, computed 08ebab80cd 2007-11-10 aku: # a lot of state which was thrown away and then computed again 08ebab80cd 2007-11-10 aku: # for each of the fragments. It should be easier to update and 08ebab80cd 2007-11-10 aku: # reuse that state. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # The code checks only sucessor dependencies, as this 08ebab80cd 2007-11-10 aku: # automatically covers the predecessor dependencies as well (A 08ebab80cd 2007-11-10 aku: # successor dependency a -> b is also a predecessor dependency 08ebab80cd 2007-11-10 aku: # b -> a). 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Array of dependencies (parent -> child). This is pulled from 95af789e1f 2007-11-10 aku: # the state, and limited to successors within the changeset. 08ebab80cd 2007-11-10 aku: 95af789e1f 2007-11-10 aku: array set dependencies {} 08ebab80cd 2007-11-10 aku: PullInternalDependencies dependencies $myrevisions 95af789e1f 2007-11-10 aku: if {![array size dependencies]} {return 0} ; # Nothing to break. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets ...<$myid>....................................................... 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # We have internal dependencies to break. We now iterate over 95af789e1f 2007-11-10 aku: # all positions in the list (which is chronological, at least 95af789e1f 2007-11-10 aku: # as far as the timestamps are correct and unique) and 95af789e1f 2007-11-10 aku: # determine the best position for the break, by trying to 08ebab80cd 2007-11-10 aku: # break as many dependencies as possible in one go. When a 08ebab80cd 2007-11-10 aku: # break was found this is redone for the fragments coming and 08ebab80cd 2007-11-10 aku: # after, after upding the crossing information. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Data structures: 08ebab80cd 2007-11-10 aku: # Map: POS revision id -> position in list. 08ebab80cd 2007-11-10 aku: # CROSS position in list -> number of dependencies crossing it 08ebab80cd 2007-11-10 aku: # DEPC dependency -> positions it crosses 08ebab80cd 2007-11-10 aku: # List: RANGE Of the positions itself. 08ebab80cd 2007-11-10 aku: # A dependency is a single-element map parent -> child 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: InitializeBreakState $myrevisions 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set fragments {} 08ebab80cd 2007-11-10 aku: set pending [list $range] 08ebab80cd 2007-11-10 aku: set at 0 08ebab80cd 2007-11-10 aku: array set breaks {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: while {$at < [llength $pending]} { 08ebab80cd 2007-11-10 aku: set current [lindex $pending $at] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets ". . .. ... ..... ........ ............." 08ebab80cd 2007-11-10 aku: log write 6 csets "Scheduled [join [PRs [lrange $pending $at end]] { }]" 08ebab80cd 2007-11-10 aku: log write 6 csets "Considering [PR $current] \[$at/[llength $pending]\]" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set best [FindBestBreak $current] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$best < 0} { 08ebab80cd 2007-11-10 aku: # The inspected range has no internal 08ebab80cd 2007-11-10 aku: # dependencies. This is a complete fragment. 08ebab80cd 2007-11-10 aku: lappend fragments $current 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets "No breaks, final" 95af789e1f 2007-11-10 aku: } else { 08ebab80cd 2007-11-10 aku: # Split the range and schedule the resulting fragments 08ebab80cd 2007-11-10 aku: # for further inspection. Remember the number of 08ebab80cd 2007-11-10 aku: # dependencies cut before we remove them from 08ebab80cd 2007-11-10 aku: # consideration, for documentation later. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set breaks($best) $cross($best) 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets "Best break @ $best, cuts [nsp $cross($best) dependency dependencies]" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: The value of best is an abolute location in 08ebab80cd 2007-11-10 aku: # myrevisions. Use the start of current to make it an 08ebab80cd 2007-11-10 aku: # index absolute to current. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set brel [expr {$best - [lindex $current 0]}] 08ebab80cd 2007-11-10 aku: set bnext $brel ; incr bnext 08ebab80cd 2007-11-10 aku: set fragbefore [lrange $current 0 $brel] 08ebab80cd 2007-11-10 aku: set fragafter [lrange $current $bnext end] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {![llength $fragbefore]} { 08ebab80cd 2007-11-10 aku: trouble internal "Tried to split off a zero-length fragment at the beginning" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: if {![llength $fragafter]} { 08ebab80cd 2007-11-10 aku: trouble internal "Tried to split off a zero-length fragment at the end" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: lappend pending $fragbefore $fragafter 08ebab80cd 2007-11-10 aku: CutAt $best 95af789e1f 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: incr at 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets ". . .. ... ..... ........ ............." 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Create changesets for the fragments, reusing the current one 08ebab80cd 2007-11-10 aku: # for the first fragment. We sort them in order to allow 08ebab80cd 2007-11-10 aku: # checking for gaps and nice messages. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set fragments [lsort -index 0 -integer $fragments] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: #puts \t.[join [PRs $fragments] .\n\t.]. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: Border [lindex $fragments 0] firsts firste 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$firsts != 0} { 08ebab80cd 2007-11-10 aku: trouble internal "Bad fragment start @ $firsts, gap, or before beginning of the range" 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set laste $firste 08ebab80cd 2007-11-10 aku: foreach fragment [lrange $fragments 1 end] { 08ebab80cd 2007-11-10 aku: Border $fragment s e 08ebab80cd 2007-11-10 aku: if {$laste != ($s - 1)} { 08ebab80cd 2007-11-10 aku: trouble internal "Bad fragment border <$laste | $s>, gap or overlap" 95af789e1f 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]] 08ebab80cd 2007-11-10 aku: lappend csets $new 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 4 csets "Breaking <$myid> @ $laste, new <[$new id]>, cutting $breaks($laste)" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set laste $e 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$laste != ([llength $myrevisions]-1)} { 08ebab80cd 2007-11-10 aku: trouble internal "Bad fragment end @ $laste, gap, or beyond end of the range" 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Put the first fragment into the current changeset. 08ebab80cd 2007-11-10 aku: set myrevisions [lrange $myrevisions 0 $firste] 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: return 1 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: method persist {} { 5f7acef887 2007-11-10 aku: set tid $mycstype($mytype) 5f7acef887 2007-11-10 aku: set pid [$myproject id] 5f7acef887 2007-11-10 aku: set pos 0 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: state transaction { 5f7acef887 2007-11-10 aku: state run { 5f7acef887 2007-11-10 aku: INSERT INTO changeset (cid, pid, type, src) 5f7acef887 2007-11-10 aku: VALUES ($myid, $pid, $tid, $mysrcid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: foreach rid $myrevisions { 5f7acef887 2007-11-10 aku: state run { 5f7acef887 2007-11-10 aku: INSERT INTO csrevision (cid, pos, rid) 5f7acef887 2007-11-10 aku: VALUES ($myid, $pos, $rid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: incr pos 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: variable myid ; # Id of the cset for the persistent state. 5f7acef887 2007-11-10 aku: variable myproject ; # Reference of the project object the changeset belongs to. 5f7acef887 2007-11-10 aku: variable mytype ; # rev or sym, where the cset originated from. 5f7acef887 2007-11-10 aku: variable mysrcid ; # id of the metadata or symbol the cset is based on. 5f7acef887 2007-11-10 aku: variable myrevisions ; # List of the file level revisions in the cset. 5f7acef887 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: typevariable mycounter 0 ; # Id counter for csets. 5f7acef887 2007-11-10 aku: typevariable mycstype -array {} ; # Map cstypes to persistent ids. 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: typemethod getcstypes {} { 5f7acef887 2007-11-10 aku: foreach {tid name} [state run { 5f7acef887 2007-11-10 aku: SELECT tid, name FROM cstype; 5f7acef887 2007-11-10 aku: }] { set mycstype($name) $tid } 5f7acef887 2007-11-10 aku: return 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PullInternalDependencies {dv revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 $dv dependencies 08ebab80cd 2007-11-10 aku: set theset ('[join $revisions {','}]') 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach {rid child} [state run " 08ebab80cd 2007-11-10 aku: -- Primary children 08ebab80cd 2007-11-10 aku: SELECT R.rid, R.child 08ebab80cd 2007-11-10 aku: FROM revision R 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset 08ebab80cd 2007-11-10 aku: AND R.child IS NOT NULL 08ebab80cd 2007-11-10 aku: AND R.child IN $theset 08ebab80cd 2007-11-10 aku: UNION 08ebab80cd 2007-11-10 aku: -- Transition NTDB to trunk 08ebab80cd 2007-11-10 aku: SELECT R.rid, R.dbchild 08ebab80cd 2007-11-10 aku: FROM revision R 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset 08ebab80cd 2007-11-10 aku: AND R.dbchild IS NOT NULL 08ebab80cd 2007-11-10 aku: AND R.dbchild IN $theset 08ebab80cd 2007-11-10 aku: UNION 08ebab80cd 2007-11-10 aku: -- Secondary (branch) children 08ebab80cd 2007-11-10 aku: SELECT R.rid, B.brid 08ebab80cd 2007-11-10 aku: FROM revision R, revisionbranchchildren B 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset 08ebab80cd 2007-11-10 aku: AND R.rid = B.rid 08ebab80cd 2007-11-10 aku: AND B.brid IN $theset 08ebab80cd 2007-11-10 aku: "] { 08ebab80cd 2007-11-10 aku: # Consider moving this to the integrity module. 08ebab80cd 2007-11-10 aku: if {$rid == $child} { 08ebab80cd 2007-11-10 aku: trouble internal "Revision $rid depends on itself." 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: set dependencies($rid) $child 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc InitializeBreakState {revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 pos pos cross cross range range depc depc delta delta \ 08ebab80cd 2007-11-10 aku: dependencies dependencies 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # First we create a map of positions to make it easier to 08ebab80cd 2007-11-10 aku: # determine whether a dependency crosses a particular index. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set pos {} 08ebab80cd 2007-11-10 aku: array set cross {} 08ebab80cd 2007-11-10 aku: array set depc {} 08ebab80cd 2007-11-10 aku: set range {} 08ebab80cd 2007-11-10 aku: set n 0 08ebab80cd 2007-11-10 aku: foreach rev $revisions { 08ebab80cd 2007-11-10 aku: lappend range $n 08ebab80cd 2007-11-10 aku: set pos($rev) $n 08ebab80cd 2007-11-10 aku: set cross($n) 0 08ebab80cd 2007-11-10 aku: incr n 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Secondly we count the crossings per position, by iterating 08ebab80cd 2007-11-10 aku: # over the recorded internal dependencies. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: If the timestamps are badly out of order it is 08ebab80cd 2007-11-10 aku: # possible to have a backward successor dependency, 08ebab80cd 2007-11-10 aku: # i.e. with start > end. We may have to swap the indices 08ebab80cd 2007-11-10 aku: # to ensure that the following loop runs correctly. 08ebab80cd 2007-11-10 aku: # 08ebab80cd 2007-11-10 aku: # Note 2: start == end is not possible. It indicates a 08ebab80cd 2007-11-10 aku: # self-dependency due to the uniqueness of positions, 08ebab80cd 2007-11-10 aku: # and that is something we have ruled out already, see 08ebab80cd 2007-11-10 aku: # PullInternalDependencies. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach {rid child} [array get dependencies] { 08ebab80cd 2007-11-10 aku: set dkey [list $rid $child] 08ebab80cd 2007-11-10 aku: set start $pos($rid) 08ebab80cd 2007-11-10 aku: set end $pos($child) 08ebab80cd 2007-11-10 aku: set crosses {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$start > $end} { 08ebab80cd 2007-11-10 aku: while {$end < $start} { 08ebab80cd 2007-11-10 aku: lappend crosses $end 08ebab80cd 2007-11-10 aku: incr cross($end) 08ebab80cd 2007-11-10 aku: incr end 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } else { 08ebab80cd 2007-11-10 aku: while {$start < $end} { 08ebab80cd 2007-11-10 aku: lappend crosses $start 08ebab80cd 2007-11-10 aku: incr cross($start) 08ebab80cd 2007-11-10 aku: incr start 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: set depc($dkey) $crosses 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: InitializeDeltas $revisions 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc InitializeDeltas {revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Pull the timestamps for all revisions in the changesets and 08ebab80cd 2007-11-10 aku: # compute their deltas for use by the break finder. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set delta {} 08ebab80cd 2007-11-10 aku: array set stamp {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set theset ('[join $revisions {','}]') 08ebab80cd 2007-11-10 aku: foreach {rid time} [state run " 08ebab80cd 2007-11-10 aku: SELECT R.rid, R.date 08ebab80cd 2007-11-10 aku: FROM revision R 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset 08ebab80cd 2007-11-10 aku: "] { 08ebab80cd 2007-11-10 aku: set stamp($rid) $time 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set n 0 08ebab80cd 2007-11-10 aku: foreach rid [lrange $revisions 0 end-1] rnext [lrange $revisions 1 end] { 08ebab80cd 2007-11-10 aku: set delta($n) [expr {$stamp($rnext) - $stamp($rid)}] 08ebab80cd 2007-11-10 aku: incr n 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc FindBestBreak {range} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Determine the best break location in the given range of 08ebab80cd 2007-11-10 aku: # positions. First we look for the locations with the maximal 08ebab80cd 2007-11-10 aku: # number of crossings. If there are several we look for the 08ebab80cd 2007-11-10 aku: # shortest time interval among them. If we still have multiple 08ebab80cd 2007-11-10 aku: # possibilities after that we select the earliest location 08ebab80cd 2007-11-10 aku: # among these. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: If the maximal number of crossings is 0 then the range 08ebab80cd 2007-11-10 aku: # has no internal dependencies, and no break location at 08ebab80cd 2007-11-10 aku: # all. This possibility is signaled via result -1. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: A range of length 1 or less cannot have internal 08ebab80cd 2007-11-10 aku: # dependencies, as that needs at least two revisions in 08ebab80cd 2007-11-10 aku: # the range. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $range] < 2} { return -1 } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set max -1 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $range { 08ebab80cd 2007-11-10 aku: set crossings $cross($location) 08ebab80cd 2007-11-10 aku: if {$crossings > $max} { 08ebab80cd 2007-11-10 aku: set max $crossings 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: continue 08ebab80cd 2007-11-10 aku: } elseif {$crossings == $max} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$max == 0} { return -1 } 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set locations $best 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: set min -1 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $locations { 08ebab80cd 2007-11-10 aku: set interval $delta($location) 08ebab80cd 2007-11-10 aku: if {($min < 0) || ($interval < $min)} { 08ebab80cd 2007-11-10 aku: set min $interval 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: } elseif {$interval == $min} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return [lindex [lsort -integer -increasing $best] 0] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc CutAt {location} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross depc depc 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # It was decided to split the changeset at the given 08ebab80cd 2007-11-10 aku: # location. This cuts a number of dependencies. Here we update 08ebab80cd 2007-11-10 aku: # the cross information so that the break finder has accurate 08ebab80cd 2007-11-10 aku: # data when we look at the generated fragments. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set six [log visible? 6] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach {dep range} [array get depc] { 08ebab80cd 2007-11-10 aku: # Check all dependencies still known, take their range and 08ebab80cd 2007-11-10 aku: # see if the break location falls within. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: if {$location < $s} continue ; # break before range, ignore 08ebab80cd 2007-11-10 aku: if {$location > $e} continue ; # break after range, ignore. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # This dependency crosses the break location. We remove it 08ebab80cd 2007-11-10 aku: # from the crossings counters, and then also from the set 08ebab80cd 2007-11-10 aku: # of known dependencies, as we are done with it. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach loc $depc($dep) { incr cross($loc) -1 } 08ebab80cd 2007-11-10 aku: unset depc($dep) 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {!$six} continue 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: struct::list assign $dep parent child 08ebab80cd 2007-11-10 aku: log write 6 csets "Broke dependency [PD $parent] --> [PD $child]" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Print identifying data for a revision (project, file, dotted rev 08ebab80cd 2007-11-10 aku: # number), for high verbosity log output. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PD {id} { 08ebab80cd 2007-11-10 aku: foreach {p f r} [state run { 08ebab80cd 2007-11-10 aku: SELECT P.name , F.name, R.rev 08ebab80cd 2007-11-10 aku: FROM revision R, file F, project P 08ebab80cd 2007-11-10 aku: WHERE R.rid = $id 08ebab80cd 2007-11-10 aku: AND R.fid = F.fid 08ebab80cd 2007-11-10 aku: AND F.pid = P.pid 08ebab80cd 2007-11-10 aku: }] break 08ebab80cd 2007-11-10 aku: return "'$p : $f/$r'" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Printing one or more ranges, formatted, and only their border to 08ebab80cd 2007-11-10 aku: # keep the strings short. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PRs {ranges} { 08ebab80cd 2007-11-10 aku: return [struct::list map $ranges [myproc PR]] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PR {range} { 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: return <${s}...${e}> 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc Border {range sv ev} { 08ebab80cd 2007-11-10 aku: upvar 1 $sv s $ev e 08ebab80cd 2007-11-10 aku: set s [lindex $range 0] 08ebab80cd 2007-11-10 aku: set e [lindex $range end] 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Configuration 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: pragma -hastypeinfo no ; # no type introspection 84de38d73f 2007-10-10 aku: pragma -hasinfo no ; # no object introspection 84de38d73f 2007-10-10 aku: pragma -simpledispatch yes ; # simple fast dispatch 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: namespace eval ::vc::fossil::import::cvs::project { 84de38d73f 2007-10-10 aku: namespace export rev 5f7acef887 2007-11-10 aku: namespace eval rev { 5f7acef887 2007-11-10 aku: namespace import ::vc::fossil::import::cvs::state 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::misc::* 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::trouble 95af789e1f 2007-11-10 aku: namespace import ::vc::tools::log 95af789e1f 2007-11-10 aku: log register csets 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Ready 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package provide vc::fossil::import::cvs::project::rev 1.0 84de38d73f 2007-10-10 aku: return
File Annotation