Return to fts3_common.tcl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test

sqlite3

    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: