@@ -17,8 +17,9 @@
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
+package require struct::set ; # Set operations.
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.
@@ -37,9 +38,11 @@
} else {
set myid [incr mycounter]
}
- integrity assert {[info exists mycstype($cstype)]} {Bad changeset type '$cstype'.}
+ integrity assert {
+ [info exists mycstype($cstype)]
+ } {Bad changeset type '$cstype'.}
set myproject $project
set mytype $cstype
set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype}
@@ -54,8 +57,9 @@
foreach iid $items {
set key [list $cstype $iid]
set myitemmap($key) $self
lappend mytitems $key
+ log write 8 csets {MAP+ item <$key> $self = [$self str]}
}
return
}
@@ -244,8 +248,9 @@
foreach iid $myitems {
set key [list $mytype $iid]
unset myitemmap($key)
+ log write 8 csets {MAP- item <$key> $self = [$self str]}
}
# Create changesets for the fragments, reusing the current one
# for the first fragment. We sort them in order to allow
@@ -284,8 +289,9 @@
set myitems [lrange $myitems 0 $firste]
foreach iid $myitems {
set key [list $mytype $iid]
set myitemmap($key) $self
+ log write 8 csets {MAP+ item <$key> $self = [$self str]}
}
return 1
}
@@ -314,8 +320,10 @@
method timerange {} { return [$mytypeobj timerange $myitems] }
method drop {} {
+ log write 8 csets {Dropping $self = [$self str]}
+
state transaction {
state run {
DELETE FROM changeset WHERE cid = $myid;
DELETE FROM csitem WHERE cid = $myid;
@@ -323,12 +331,43 @@
}
foreach iid $myitems {
set key [list $mytype $iid]
unset myitemmap($key)
+ log write 8 csets {MAP- item <$key> $self = [$self str]}
}
set pos [lsearch -exact $mychangesets $self]
set mychangesets [lreplace $mychangesets $pos $pos]
return
+ }
+
+ method selfreferential {} {
+ log write 9 csets {Checking [$self str] /[llength $myitems]}
+
+ if {![struct::set contains [$self successors] $self]} {
+ return 0
+ }
+ if {[log verbosity?] < 8} { return 1 }
+
+ # Print the detailed successor structure of the self-
+ # referential changeset, if the verbosity of the log is dialed
+ # high enough.
+
+ log write 8 csets [set hdr {Self-referential changeset [$self str] __________________}]
+ array set nmap [$self nextmap]
+ foreach item [lsort -dict [array names nmap]] {
+ foreach succitem $nmap($item) {
+ set succcs $myitemmap($succitem)
+ set hint [expr {($succcs eq $self)
+ ? "LOOP"
+ : " "}]
+ set i "<$item [$type itemstr $item]>"
+ set s "<$succitem [$type itemstr $succitem]>"
+ set scs [$succcs str]
+ log write 8 csets {$hint * $i --> $s --> cs $scs}
+ }
+ }
+ log write 8 csets [regsub -all {[^ ]} $hdr {_}]
+ return 1
}
typemethod split {cset args} {
# As part of the creation of the new changesets specified in
@@ -339,23 +378,61 @@
# Note: The item lists found in args are tagged items. They
# have to have the same type as the changeset, being subsets
# of its items. This is checked in Untag1.
+ # Constraints: No fragment must be empty. All fragments have
+ # to be subsets of the cset. The union has to cover the
+ # original. All pairwise intersections have to be empty.
+
+ log write 8 csets {OLD: [lsort [$cset items]]}
+
+ set cover {}
+ foreach fragmentitems $args {
+ log write 8 csets {NEW: [lsort $fragmentitems]}
+
+ integrity assert {
+ ![struct::set empty $fragmentitems]
+ } {changeset fragment is empty}
+ integrity assert {
+ [struct::set subsetof $fragmentitems [$cset items]]
+ } {changeset fragment is not a subset}
+ struct::set add cover $fragmentitems
+ }
+ integrity assert {
+ [struct::set equal $cover [$cset items]]
+ } {The fragments do not cover the original changeset}
+ set i 1
+ foreach fia $args {
+ foreach fib [lrange $args $i end] {
+ integrity assert {
+ [struct::set empty [struct::set intersect $fia $fib]]
+ } {The fragments <$fia> and <$fib> overlap}
+ }
+ incr i
+ }
+
+ # All checks pass, actually perform the split.
+
struct::list assign [$cset data] project cstype cssrc
$cset drop
$cset destroy
set newcsets {}
foreach fragmentitems $args {
- integrity assert {
- [llength $fragmentitems]
- } {Attempted to create an empty changeset, i.e. without items}
- lappend newcsets [$type %AUTO% $project $cstype $cssrc \
- [Untag $fragmentitems $cstype]]
- }
-
- foreach c $newcsets { $c persist }
+ log write 8 csets {MAKE: [lsort $fragmentitems]}
+
+ set fragment [$type %AUTO% $project $cstype $cssrc \
+ [Untag $fragmentitems $cstype]]
+ lappend newcsets $fragment
+ $fragment persist
+
+ if {[$fragment selfreferential]} {
+ trouble fatal "[$fragment str] depends on itself"
+ }
+ }
+
+ trouble abort?
return $newcsets
}
typemethod strlist {changesets} {
@@ -371,8 +448,13 @@
proc Untag1 {cstype theitem} {
struct::list assign $theitem t i
integrity assert {$cstype eq $t} {Item $i's type is '$t', expected '$cstype'}
return $i
+ }
+
+ typemethod itemstr {item} {
+ struct::list assign $item itype iid
+ return [$itype str $iid]
}
# # ## ### ##### ######## #############
## State
@@ -675,8 +757,19 @@
typemethod bysymbol {} { return 0 }
typemethod istag {} { return 0 }
typemethod isbranch {} { return 0 }
+ typemethod str {revision} {
+ struct::list assign [state run {
+ SELECT R.rev, F.name, P.name
+ FROM revision R, file F, project P
+ WHERE R.rid = $revision
+ AND F.fid = R.fid
+ AND P.pid = F.pid
+ }] revnr fname pname
+ return "$pname/${revnr}::$fname"
+ }
+
# result = list (mintime, maxtime)
typemethod timerange {items} {
set theset ('[join $items {','}]')
return [state run "
@@ -919,8 +1012,20 @@
typemethod bysymbol {} { return 1 }
typemethod istag {} { return 1 }
typemethod isbranch {} { return 0 }
+ typemethod str {tag} {
+ struct::list assign [state run {
+ SELECT S.name, F.name, P.name
+ FROM tag T, symbol S, file F, project P
+ WHERE T.tid = $tag
+ AND F.fid = T.fid
+ AND P.pid = F.pid
+ AND S.sid = T.sid
+ }] sname fname pname
+ return "$pname/T'${sname}'::$fname"
+ }
+
# result = list (mintime, maxtime)
typemethod timerange {tags} {
# The range is defined as the range of the revisions the tags
# are attached to.
@@ -986,8 +1091,20 @@
typemethod byrevision {} { return 0 }
typemethod bysymbol {} { return 1 }
typemethod istag {} { return 0 }
typemethod isbranch {} { return 1 }
+
+ typemethod str {branch} {
+ struct::list assign [state run {
+ SELECT S.name, F.name, P.name
+ FROM branch B, symbol S, file F, project P
+ WHERE B.bid = $branch
+ AND F.fid = B.fid
+ AND P.pid = F.pid
+ AND S.sid = B.sid
+ }] sname fname pname
+ return "$pname/B'${sname}'::$fname"
+ }
# result = list (mintime, maxtime)
typemethod timerange {branches} {
# The range of a branch is defined as the range of the