@@ -50,9 +50,13 @@
# Keep track of the generated changesets and of the inverse
# mapping from revisions to them.
lappend mychangesets $self
set myidmap($myid) $self
- foreach r $revisions { lappend myrevmap($r) $self }
+ foreach r $revisions {
+ set key [list $cstype $id]
+ set myrevmap($key) $self
+ lappend mytitems $key
+ }
return
}
method str {} {
@@ -69,9 +73,9 @@
return $str
}
method id {} { return $myid }
- method revisions {} { return $myrevisions }
+ method revisions {} { return $mytitems }
method data {} { return [list $myproject $mytype $mysrcid] }
delegate method bysymbol to mytypeobj
delegate method byrevision to mytypeobj
@@ -80,9 +84,9 @@
method setpos {p} { set mypos $p ; return }
method pos {} { return $mypos }
- # result = dict (revision -> list (changeset))
+ # result = dict (item -> list (changeset))
method successormap {} {
# NOTE / FUTURE: Possible bottleneck.
array set tmp {}
foreach {rev children} [$self nextmap] {
@@ -96,8 +100,9 @@
}
return [array get tmp]
}
+ # result = list (changeset)
method successors {} {
# NOTE / FUTURE: Possible bottleneck.
set csets {}
foreach {_ children} [$self nextmap] {
@@ -110,9 +115,9 @@
}
return [lsort -unique $csets]
}
- # result = dict (revision -> list (changeset))
+ # result = dict (item -> list (changeset))
method predecessormap {} {
# NOTE / FUTURE: Possible bottleneck.
array set tmp {}
foreach {rev children} [$self premap] {
@@ -126,17 +131,17 @@
}
return [array get tmp]
}
- # revision -> list (revision)
+ # item -> list (item)
method nextmap {} {
if {[llength $mynextmap]} { return $mynextmap }
$mytypeobj successors tmp $myrevisions
set mynextmap [array get tmp]
return $mynextmap
}
- # revision -> list (revision)
+ # item -> list (item)
method premap {} {
if {[llength $mypremap]} { return $mypremap }
$mytypeobj predecessors tmp $myrevisions
set mypremap [array get tmp]
@@ -245,9 +250,12 @@
# in-memory index in preparation for new data. A simple unset
# is enough, we have no symbol changesets at this time, and
# thus never more than one reference in the list.
- foreach r $myrevisions { unset myrevmap($r) }
+ foreach r $myrevisions {
+ set key [list $mytype $r]
+ unset myrevmap($key)
+ }
# Create changesets for the fragments, reusing the current one
# for the first fragment. We sort them in order to allow
# checking for gaps and nice messages.
@@ -283,9 +291,12 @@
# here, none of the changesets has been saved to the
# persistent state yet.
set myrevisions [lrange $myrevisions 0 $firste]
- foreach r $myrevisions { lappend myrevmap($r) $self }
+ foreach r $myrevisions {
+ set key [list $mytype $r]
+ set myrevmap($key) $self
+ }
return 1
}
@@ -320,14 +331,10 @@
DELETE FROM csrevision WHERE cid = $myid;
}
}
foreach r $myrevisions {
- if {[llength $myrevmap($r)] == 1} {
- unset myrevmap($r)
- } else {
- set pos [lsearch -exact $myrevmap($r) $self]
- set myrevmap($r) [lreplace $myrevmap($r) $pos $pos]
- }
+ set key [list $mytype $r]
+ unset myrevmap($key)
}
set pos [lsearch -exact $mychangesets $self]
set mychangesets [lreplace $mychangesets $pos $pos]
return
@@ -337,8 +344,12 @@
# As part of the creation of the new changesets specified in
# ARGS as sets of revisions, all subsets of CSET's revision
# set, CSET will be dropped from all databases, in and out of
# memory, and then destroyed.
+ #
+ # 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.
struct::list assign [$cset data] project cstype cssrc
$cset drop
@@ -348,9 +359,10 @@
foreach fragmentrevisions $args {
integrity assert {
[llength $fragmentrevisions]
} {Attempted to create an empty changeset, i.e. without revisions}
- lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions]
+ lappend newcsets [$type %AUTO% $project $cstype $cssrc \
+ [Untag $fragmentrevisions $cstype]]
}
foreach c $newcsets { $c persist }
return $newcsets
@@ -360,8 +372,18 @@
return [join [struct::list map $changesets [myproc ID]]]
}
proc ID {cset} { $cset str }
+
+ proc Untag {taggeditems cstype} {
+ return [struct::list map $taggeditems [myproc Untag1 $cstype]]
+ }
+
+ 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
+ }
# # ## ### ##### ######## #############
## State
@@ -380,18 +402,20 @@
# type dependent code. Derived from
# mytype.
variable mysrcid {} ; # Id of the metadata or symbol the cset
# is based on.
- variable myrevisions {} ; # List of the file level revisions in
- # the cset.
- variable mypremap {} ; # Dictionary mapping from the revisions
- # to their predecessors. Cache to avoid
- # loading this from the state more than
- # once.
- variable mynextmap {} ; # Dictionary mapping from the revisions
- # to their successors. Cache to avoid
- # loading this from the state more than
- # once.
+ variable myrevisions {} ; # List of the file level revisions,
+ # tags, or branches in the cset, as
+ # ids. Not tagged.
+ variable mytitems {} ; # As myrevisions, the tagged form.
+ variable mypremap {} ; # Dictionary mapping from the items (tagged now)
+ # to their predecessors, also tagged. A
+ # cache to avoid loading this from the
+ # state more than once.
+ variable mynextmap {} ; # Dictionary mapping from the items (tagged)
+ # to their successors (also tagged). A
+ # cache to avoid loading this from the
+ # state more than once.
variable mypos {} ; # Commit position of the changeset, if
# known.
# # ## ### ##### ######## #############
@@ -631,16 +655,12 @@
# # ## ### ##### ######## #############
typevariable mychangesets {} ; # List of all known changesets.
- typevariable myrevmap -array {} ; # Map from revisions to the list
- # of changesets containing
- # it. NOTE: While only one
- # revision changeset can contain
- # the revision, there can
- # however also be one or more
- # additional symbol changesets
- # which use it, hence a list.
+ typevariable myrevmap -array {} ; # Map from items (tagged) to the
+ # list of changesets containing
+ # it. Each item can be used by
+ # only one changeset.
typevariable myidmap -array {} ; # Map from changeset id to changeset.
typemethod all {} { return $mychangesets }
typemethod of {id} { return $myidmap($id) }