000001  # 2014 May 6.
000002  #
000003  # The author disclaims copyright to this source code.  In place of
000004  # a legal notice, here is a blessing:
000005  #
000006  #    May you do good and not evil.
000007  #    May you find forgiveness for yourself and forgive others.
000008  #    May you share freely, never taking more than you give.
000009  #
000010  #***********************************************************************
000011  # TESTRUNNER: superslow
000012  #
000013  # This file implements regression tests for SQLite library. 
000014  #
000015  # The tests in this file are brute force tests of the multi-threaded
000016  # sorter.
000017  #
000018  
000019  set testdir [file dirname $argv0]
000020  source $testdir/tester.tcl
000021  set testprefix sort4
000022  db close
000023  sqlite3_shutdown
000024  sqlite3_config_pmasz 10
000025  sqlite3_initialize
000026  sqlite3 db test.db
000027  
000028  
000029  # Configure the sorter to use 3 background threads.
000030  #
000031  # EVIDENCE-OF: R-19249-32353 SQLITE_LIMIT_WORKER_THREADS The maximum
000032  # number of auxiliary worker threads that a single prepared statement
000033  # may start.
000034  #
000035  do_test sort4-init001 {
000036    db eval {PRAGMA threads=5}
000037    sqlite3_limit db SQLITE_LIMIT_WORKER_THREADS -1
000038  } {5}
000039  do_test sort4-init002 {
000040    sqlite3_limit db SQLITE_LIMIT_WORKER_THREADS 3
000041    db eval {PRAGMA threads}
000042  } {3}
000043  
000044  
000045  # Minimum number of seconds to run for. If the value is 0, each test
000046  # is run exactly once. Otherwise, tests are repeated until the timeout
000047  # expires.
000048  set SORT4TIMEOUT 0
000049  if {[permutation] == "multithread"} { set SORT4TIMEOUT 300 }
000050  
000051  #--------------------------------------------------------------------
000052  # Set up a table "t1" containing $nRow rows. Each row contains also
000053  # contains blob fields that collectively contain at least $nPayload 
000054  # bytes of content. The table schema is as follows:
000055  #
000056  #   CREATE TABLE t1(a INTEGER, <extra-columns>, b INTEGER);
000057  #
000058  # For each row, the values of columns "a" and "b" are set to the same
000059  # pseudo-randomly selected integer. The "extra-columns", of which there
000060  # are at most eight, are named c0, c1, c2 etc. Column c0 contains a 4
000061  # byte string. Column c1 an 8 byte string. Field c2 16 bytes, and so on.
000062  #
000063  # This table is intended to be used for testing queries of the form: 
000064  #
000065  #   SELECT a, <cols>, b FROM t1 ORDER BY a;
000066  #
000067  # The test code checks that rows are returned in order, and that the 
000068  # values of "a" and "b" are the same for each row (the idea being that
000069  # if field "b" at the end of the sorter record has not been corrupted, 
000070  # the rest of the record is probably Ok as well).
000071  #
000072  proc populate_table {nRow nPayload} {
000073    set nCol 0
000074  
000075    set n 0
000076    for {set nCol 0} {$n < $nPayload} {incr nCol} {
000077      incr n [expr (4 << $nCol)]
000078    }
000079  
000080    set cols [lrange [list xxx c0 c1 c2 c3 c4 c5 c6 c7] 1 $nCol]
000081    set data [lrange [list xxx \
000082        randomblob(4) randomblob(8) randomblob(16) randomblob(32) \
000083        randomblob(64) randomblob(128) randomblob(256) randomblob(512) \
000084    ] 1 $nCol]
000085  
000086    execsql { DROP TABLE IF EXISTS t1 }
000087  
000088    db transaction {
000089      execsql "CREATE TABLE t1(a, [join $cols ,], b);"
000090      set insert "INSERT INTO t1 VALUES(:k, [join $data ,], :k)"
000091      for {set i 0} {$i < $nRow} {incr i} {
000092        set k [expr int(rand()*1000000000)]
000093        execsql $insert
000094      }
000095    }
000096  }
000097  
000098  # Helper for [do_sorter_test]
000099  #
000100  proc sorter_test {nRow nRead nPayload} {
000101    set res [list]
000102  
000103    set nLoad [expr ($nRow > $nRead) ? $nRead : $nRow]
000104  
000105    set nPayload [expr (($nPayload+3)/4) * 4]
000106    set cols [list]
000107    foreach {mask col} { 
000108      0x04  c0 0x08  c1 0x10  c2 0x20  c3 
000109      0x40  c4 0x80  c5 0x100 c6 0x200 c7 
000110    } {
000111      if {$nPayload & $mask} { lappend cols $col }
000112    }
000113  
000114    # Create two SELECT statements. Statement $sql1 uses the sorter to sort
000115    # $nRow records of a bit over $nPayload bytes each read from the "t1"
000116    # table created by [populate_table] proc above. Rows are sorted in order
000117    # of the integer field in each "t1" record.
000118    #
000119    # The second SQL statement sorts the same set of rows as the first, but
000120    # uses a LIMIT clause, causing SQLite to use a temp table instead of the
000121    # sorter for sorting.
000122    #
000123    set sql1 "SELECT a, [join $cols ,], b FROM t1 WHERE rowid<=$nRow ORDER BY a"
000124    set sql2 "SELECT a FROM t1 WHERE rowid<=$nRow ORDER BY a LIMIT $nRead"
000125  
000126    # Pass the two SQL statements to a helper command written in C. This
000127    # command steps statement $sql1 $nRead times and compares the integer
000128    # values in the rows returned with the results of executing $sql2. If
000129    # the comparison fails (indicating some bug in the sorter), a Tcl
000130    # exception is thrown.
000131    #
000132    sorter_test_sort4_helper db $sql1 $nRead $sql2
000133    set {} {} 
000134  }
000135  
000136  # Usage:
000137  #
000138  #   do_sorter_test <testname> <args>...
000139  #
000140  # where <args> are any of the following switches:
000141  #
000142  #   -rows N          (number of rows to have sorter sort)
000143  #   -read N          (number of rows to read out of sorter)
000144  #   -payload N       (bytes of payload to read with each row)
000145  #   -cachesize N     (Value for "PRAGMA cache_size = ?")
000146  #   -repeats N       (number of times to repeat test)
000147  #   -fakeheap BOOL   (true to use separate allocations for in-memory records)
000148  #
000149  proc do_sorter_test {tn args} {
000150    set a(-rows)      1000
000151    set a(-repeats)   1
000152    set a(-read)      100
000153    set a(-payload)   100
000154    set a(-cachesize) 100
000155    set a(-fakeheap)  0
000156  
000157    foreach {s val} $args {
000158      if {[info exists a($s)]==0} { 
000159        unset a(-cachesize)
000160        set optlist "[join [array names a] ,] or -cachesize"
000161        error "Unknown option $s, expected $optlist"
000162      }
000163      set a($s) $val
000164    }
000165    if {[permutation] == "memsys3" || [permutation] == "memsys5"} {
000166      set a(-fakeheap) 0
000167    }
000168    if {$a(-fakeheap)} { sorter_test_fakeheap 1 }
000169  
000170  
000171    db eval "PRAGMA cache_size = $a(-cachesize)"
000172    do_test $tn [subst -nocommands {
000173      for {set i 0} {[set i] < $a(-repeats)} {incr i} {
000174        sorter_test $a(-rows) $a(-read) $a(-payload)
000175      }
000176    }] {}
000177  
000178    if {$a(-fakeheap)} { sorter_test_fakeheap 0 }
000179  }
000180  
000181  proc clock_seconds {} {
000182    db one {SELECT strftime('%s')}
000183  }
000184  
000185  #-------------------------------------------------------------------------
000186  # Begin tests here.
000187  
000188  # Create a test database.
000189  do_test 1 {
000190    execsql "PRAGMA page_size = 4096"
000191    populate_table 100000 500
000192  } {}
000193  
000194  set iTimeLimit [expr [clock_seconds] + $SORT4TIMEOUT]
000195  
000196  for {set t 2} {1} {incr tn} {
000197    do_sorter_test $t.2 -repeats 10 -rows 1000   -read 100
000198    do_sorter_test $t.3 -repeats 10 -rows 100000 -read 1000
000199    do_sorter_test $t.4 -repeats 10 -rows 100000 -read 1000 -payload 500
000200    do_sorter_test $t.5 -repeats 10 -rows 100000 -read 100000 -payload 8
000201    do_sorter_test $t.6 -repeats 10 -rows 100000 -read 10 -payload 8
000202    do_sorter_test $t.7 -repeats 10 -rows 10000 -read 10000 -payload 8 -fakeheap 1
000203    do_sorter_test $t.8 -repeats 10 -rows 100000 -read 10000 -cachesize 250
000204  
000205    set iNow [clock_seconds]
000206    if {$iNow>=$iTimeLimit} break
000207    do_test "$testprefix-([expr $iTimeLimit-$iNow] seconds remain)" {} {}
000208  }
000209  
000210  finish_test