Annotation of embedaddon/sqlite3/test/fts3_common.tcl, revision 1.1
1.1 ! misho 1: # 2009 November 04
! 2: #
! 3: # The author disclaims copyright to this source code. In place of
! 4: # a legal notice, here is a blessing:
! 5: #
! 6: # May you do good and not evil.
! 7: # May you find forgiveness for yourself and forgive others.
! 8: # May you share freely, never taking more than you give.
! 9: #
! 10: #***********************************************************************
! 11: #
! 12: # This file contains common code used the fts3 tests. At one point
! 13: # equivalent functionality was implemented in C code. But it is easier
! 14: # to use Tcl.
! 15: #
! 16:
! 17: #-------------------------------------------------------------------------
! 18: # USAGE: fts3_integrity_check TBL
! 19: #
! 20: # This proc is used to verify that the full-text index is consistent with
! 21: # the contents of the fts3 table. In other words, it checks that the
! 22: # data in the %_contents table matches that in the %_segdir and %_segments
! 23: # tables.
! 24: #
! 25: # This is not an efficient procedure. It uses a lot of memory and a lot
! 26: # of CPU. But it is better than not checking at all.
! 27: #
! 28: # The procedure is:
! 29: #
! 30: # 1) Read the entire full-text index from the %_segdir and %_segments
! 31: # tables into memory. For each entry in the index, the following is
! 32: # done:
! 33: #
! 34: # set C($iDocid,$iCol,$iPosition) $zTerm
! 35: #
! 36: # 2) Iterate through each column of each row of the %_content table.
! 37: # Tokenize all documents, and check that for each token there is
! 38: # a corresponding entry in the $C array. After checking a token,
! 39: # [unset] the $C array entry.
! 40: #
! 41: # 3) Check that array $C is now empty.
! 42: #
! 43: #
! 44: proc fts3_integrity_check {tbl} {
! 45:
! 46: fts3_read2 $tbl 1 A
! 47:
! 48: foreach zTerm [array names A] {
! 49: foreach doclist $A($zTerm) {
! 50: set docid 0
! 51: while {[string length $doclist]>0} {
! 52: set iCol 0
! 53: set iPos 0
! 54: set lPos [list]
! 55: set lCol [list]
! 56:
! 57: # First varint of a doclist-entry is the docid. Delta-compressed
! 58: # with respect to the docid of the previous entry.
! 59: #
! 60: incr docid [gobble_varint doclist]
! 61: if {[info exists D($zTerm,$docid)]} {
! 62: while {[set iDelta [gobble_varint doclist]] != 0} {}
! 63: continue
! 64: }
! 65: set D($zTerm,$docid) 1
! 66:
! 67: # Gobble varints until the 0x00 that terminates the doclist-entry
! 68: # is found.
! 69: while {[set iDelta [gobble_varint doclist]] > 0} {
! 70: if {$iDelta == 1} {
! 71: set iCol [gobble_varint doclist]
! 72: set iPos 0
! 73: } else {
! 74: incr iPos $iDelta
! 75: incr iPos -2
! 76: set C($docid,$iCol,$iPos) $zTerm
! 77: }
! 78: }
! 79: }
! 80: }
! 81: }
! 82:
! 83: foreach key [array names C] {
! 84: #puts "$key -> $C($key)"
! 85: }
! 86:
! 87:
! 88: db eval "SELECT * FROM ${tbl}_content" E {
! 89: set iCol 0
! 90: set iDoc $E(docid)
! 91: foreach col [lrange $E(*) 1 end] {
! 92: set c $E($col)
! 93: set sql {SELECT fts3_tokenizer_test('simple', $c)}
! 94:
! 95: foreach {pos term dummy} [db one $sql] {
! 96: if {![info exists C($iDoc,$iCol,$pos)]} {
! 97: set es "Error at docid=$iDoc col=$iCol pos=$pos. Index is missing"
! 98: lappend errors $es
! 99: } else {
! 100: if {$C($iDoc,$iCol,$pos) != "$term"} {
! 101: set es "Error at docid=$iDoc col=$iCol pos=$pos. Index "
! 102: append es "has \"$C($iDoc,$iCol,$pos)\", document has \"$term\""
! 103: lappend errors $es
! 104: }
! 105: unset C($iDoc,$iCol,$pos)
! 106: }
! 107: }
! 108: incr iCol
! 109: }
! 110: }
! 111:
! 112: foreach c [array names C] {
! 113: lappend errors "Bad index entry: $c -> $C($c)"
! 114: }
! 115:
! 116: if {[info exists errors]} { return [join $errors "\n"] }
! 117: return "ok"
! 118: }
! 119:
! 120: # USAGE: fts3_terms TBL WHERE
! 121: #
! 122: # Argument TBL must be the name of an FTS3 table. Argument WHERE is an
! 123: # SQL expression that will be used as the WHERE clause when scanning
! 124: # the %_segdir table. As in the following query:
! 125: #
! 126: # "SELECT * FROM ${TBL}_segdir WHERE ${WHERE}"
! 127: #
! 128: # This function returns a list of all terms present in the segments
! 129: # selected by the statement above.
! 130: #
! 131: proc fts3_terms {tbl where} {
! 132: fts3_read $tbl $where a
! 133: return [lsort [array names a]]
! 134: }
! 135:
! 136:
! 137: # USAGE: fts3_doclist TBL TERM WHERE
! 138: #
! 139: # Argument TBL must be the name of an FTS3 table. TERM is a term that may
! 140: # or may not be present in the table. Argument WHERE is used to select a
! 141: # subset of the b-tree segments in the associated full-text index as
! 142: # described above for [fts3_terms].
! 143: #
! 144: # This function returns the results of merging the doclists associated
! 145: # with TERM in the selected segments. Each doclist is an element of the
! 146: # returned list. Each doclist is formatted as follows:
! 147: #
! 148: # [$docid ?$col[$off1 $off2...]?...]
! 149: #
! 150: # The formatting is odd for a Tcl command in order to be compatible with
! 151: # the original C-language implementation. If argument WHERE is "1", then
! 152: # any empty doclists are omitted from the returned list.
! 153: #
! 154: proc fts3_doclist {tbl term where} {
! 155: fts3_read $tbl $where a
! 156:
! 157:
! 158: foreach doclist $a($term) {
! 159: set docid 0
! 160:
! 161: while {[string length $doclist]>0} {
! 162: set iCol 0
! 163: set iPos 0
! 164: set lPos [list]
! 165: set lCol [list]
! 166: incr docid [gobble_varint doclist]
! 167:
! 168: while {[set iDelta [gobble_varint doclist]] > 0} {
! 169: if {$iDelta == 1} {
! 170: lappend lCol [list $iCol $lPos]
! 171: set iPos 0
! 172: set lPos [list]
! 173: set iCol [gobble_varint doclist]
! 174: } else {
! 175: incr iPos $iDelta
! 176: incr iPos -2
! 177: lappend lPos $iPos
! 178: }
! 179: }
! 180:
! 181: if {[llength $lPos]>0} {
! 182: lappend lCol [list $iCol $lPos]
! 183: }
! 184:
! 185: if {$where != "1" || [llength $lCol]>0} {
! 186: set ret($docid) $lCol
! 187: } else {
! 188: unset -nocomplain ret($docid)
! 189: }
! 190: }
! 191: }
! 192:
! 193: set lDoc [list]
! 194: foreach docid [lsort -integer [array names ret]] {
! 195: set lCol [list]
! 196: set cols ""
! 197: foreach col $ret($docid) {
! 198: foreach {iCol lPos} $col {}
! 199: append cols " $iCol\[[join $lPos { }]\]"
! 200: }
! 201: lappend lDoc "\[${docid}${cols}\]"
! 202: }
! 203:
! 204: join $lDoc " "
! 205: }
! 206:
! 207: ###########################################################################
! 208:
! 209: proc gobble_varint {varname} {
! 210: upvar $varname blob
! 211: set n [read_fts3varint $blob ret]
! 212: set blob [string range $blob $n end]
! 213: return $ret
! 214: }
! 215: proc gobble_string {varname nLength} {
! 216: upvar $varname blob
! 217: set ret [string range $blob 0 [expr $nLength-1]]
! 218: set blob [string range $blob $nLength end]
! 219: return $ret
! 220: }
! 221:
! 222: # The argument is a blob of data representing an FTS3 segment leaf.
! 223: # Return a list consisting of alternating terms (strings) and doclists
! 224: # (blobs of data).
! 225: #
! 226: proc fts3_readleaf {blob} {
! 227: set zPrev ""
! 228: set terms [list]
! 229:
! 230: while {[string length $blob] > 0} {
! 231: set nPrefix [gobble_varint blob]
! 232: set nSuffix [gobble_varint blob]
! 233:
! 234: set zTerm [string range $zPrev 0 [expr $nPrefix-1]]
! 235: append zTerm [gobble_string blob $nSuffix]
! 236: set doclist [gobble_string blob [gobble_varint blob]]
! 237:
! 238: lappend terms $zTerm $doclist
! 239: set zPrev $zTerm
! 240: }
! 241:
! 242: return $terms
! 243: }
! 244:
! 245: proc fts3_read2 {tbl where varname} {
! 246: upvar $varname a
! 247: array unset a
! 248: db eval " SELECT start_block, leaves_end_block, root
! 249: FROM ${tbl}_segdir WHERE $where
! 250: ORDER BY level ASC, idx DESC
! 251: " {
! 252: if {$start_block == 0} {
! 253: foreach {t d} [fts3_readleaf $root] { lappend a($t) $d }
! 254: } else {
! 255: db eval " SELECT block
! 256: FROM ${tbl}_segments
! 257: WHERE blockid>=$start_block AND blockid<=$leaves_end_block
! 258: ORDER BY blockid
! 259: " {
! 260: foreach {t d} [fts3_readleaf $block] { lappend a($t) $d }
! 261:
! 262: }
! 263: }
! 264: }
! 265: }
! 266:
! 267: proc fts3_read {tbl where varname} {
! 268: upvar $varname a
! 269: array unset a
! 270: db eval " SELECT start_block, leaves_end_block, root
! 271: FROM ${tbl}_segdir WHERE $where
! 272: ORDER BY level DESC, idx ASC
! 273: " {
! 274: if {$start_block == 0} {
! 275: foreach {t d} [fts3_readleaf $root] { lappend a($t) $d }
! 276: } else {
! 277: db eval " SELECT block
! 278: FROM ${tbl}_segments
! 279: WHERE blockid>=$start_block AND blockid<$leaves_end_block
! 280: ORDER BY blockid
! 281: " {
! 282: foreach {t d} [fts3_readleaf $block] { lappend a($t) $d }
! 283:
! 284: }
! 285: }
! 286: }
! 287: }
! 288:
! 289: ##########################################################################
! 290:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to fts3_common.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test