test/vtabH.test

   1 # 2015 Nov 24
   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 # This file implements regression tests for SQLite library. Specifically,
  12 # it tests that the GLOB, LIKE and REGEXP operators are correctly exposed
  13 # to virtual table implementations.
  14 #
  15
  16 set testdir [file dirname $argv0]
  17 source $testdir/tester.tcl
  18 set testprefix vtabH
  19
  20 ifcapable !vtab {
  21   finish_test
  22   return
  23 }
  24
  25 register_echo_module db
  26
  27 do_execsql_test 1.0 {
  28   CREATE TABLE t6(a, b TEXT);
  29   CREATE INDEX i6 ON t6(b, a);
  30   CREATE VIRTUAL TABLE e6 USING echo(t6);
  31 }
  32
  33 foreach {tn sql expect} {
  34   1 "SELECT * FROM e6 WHERE b LIKE '8abc'" {
  35     xBestIndex {SELECT rowid, a, b FROM 't6' WHERE b like ?}
  36     xFilter {SELECT rowid, a, b FROM 't6' WHERE b like ?} 8abc
  37   }
  38
  39   2 "SELECT * FROM e6 WHERE b GLOB '8abc'" {
  40     xBestIndex {SELECT rowid, a, b FROM 't6' WHERE b glob ?}
  41     xFilter {SELECT rowid, a, b FROM 't6' WHERE b glob ?} 8abc
  42   }
  43 } {
  44   do_test 1.$tn {
  45     set echo_module {}
  46     execsql $sql
  47     set ::echo_module
  48   } [list {*}$expect]
  49 }
  50
  51
  52 #--------------------------------------------------------------------------
  53
  54 register_tclvar_module db
  55 set ::xyz 10
  56 do_execsql_test 2.0 {
  57   CREATE VIRTUAL TABLE vars USING tclvar;
  58   SELECT name, arrayname, value FROM vars WHERE name = 'xyz';
  59 } {xyz {} 10}
  60
  61 set x1 aback
  62 set x2 abaft
  63 set x3 abandon
  64 set x4 abandonint
  65 set x5 babble
  66 set x6 baboon
  67 set x7 backbone
  68 set x8 backarrow
  69 set x9 castle
  70
  71 db func glob -argcount 2 gfunc
  72 proc gfunc {a b} {
  73   incr ::gfunc
  74   return 1
  75 }
  76
  77 db func like -argcount 2 lfunc
  78 proc lfunc {a b} {
  79   incr ::gfunc 100
  80   return 1
  81 }
  82
  83 db func regexp -argcount 2 rfunc
  84 proc rfunc {a b} {
  85   incr ::gfunc 10000
  86   return 1
  87 }
  88
  89 foreach ::tclvar_set_omit {0 1} {
  90   foreach {tn expr res cnt} {
  91     1 {value GLOB 'aban*'} {x3 abandon x4 abandonint} 2
  92     2 {value LIKE '%ac%'}  {x1 aback x7 backbone x8 backarrow} 300
  93     3 {value REGEXP '^......$'}  {x5 babble x6 baboon x9 castle} 30000
  94   } {
  95     db cache flush
  96     set ::gfunc 0
  97     if {$::tclvar_set_omit} {set cnt 0}
  98
  99     do_test 2.$tclvar_set_omit.$tn.1 {
 100       execsql "SELECT name, value FROM vars WHERE name MATCH 'x*' AND $expr"
 101     } $res
 102
 103     do_test 2.$tclvar_set_omit.$tn.2 {
 104       set ::gfunc
 105     } $cnt
 106   }
 107 }
 108
 109 #-------------------------------------------------------------------------
 110 #
 111 if {$tcl_platform(platform)=="windows"} {
 112   set drive [string range [pwd] 0 1]
 113   set ::env(fstreeDrive) $drive
 114 }
 115 if {$tcl_platform(platform)!="windows" || \
 116     [regexp -nocase -- {^[A-Z]:} $drive]} {
 117   reset_db
 118   register_fs_module db
 119   do_execsql_test 3.0 {
 120     SELECT name FROM fsdir WHERE dir = '.' AND name = 'test.db';
 121     SELECT name FROM fsdir WHERE dir = '.' AND name = '.'
 122   } {test.db .}
 123
 124   proc sort_files { names {nocase false} } {
 125     if {$nocase && $::tcl_platform(platform) eq "windows"} {
 126       return [lsort -nocase $names]
 127     } else {
 128       return [lsort $names]
 129     }
 130   }
 131
 132   proc list_root_files {} {
 133     if {$::tcl_platform(platform) eq "windows"} {
 134       set res [list]; set dir $::env(fstreeDrive)/; set names [list]
 135       eval lappend names [glob -nocomplain -directory $dir -- *]
 136       foreach name $names {
 137         if {[string index [file tail $name] 0] eq "."} continue
 138         if {[file attributes $name -hidden]} continue
 139         if {[file attributes $name -system]} continue
 140         lappend res $name
 141       }
 142       return [sort_files $res true]
 143     } else {
 144       return [sort_files [string map {/ {}} [glob -nocomplain -- /*]]]
 145     }
 146   }
 147
 148   proc list_files { pattern } {
 149     if {$::tcl_platform(platform) eq "windows"} {
 150       set res [list]; set names [list]
 151       eval lappend names [glob -nocomplain -- $pattern]
 152       foreach name $names {
 153         if {[string index [file tail $name] 0] eq "."} continue
 154         if {[file attributes $name -hidden]} continue
 155         if {[file attributes $name -system]} continue
 156         lappend res $name
 157       }
 158       return [sort_files $res]
 159     } else {
 160       return [sort_files [glob -nocomplain -- $pattern]]
 161     }
 162   }
 163
 164   # Read the first 5 entries from the root directory.  Except, ignore
 165   # files that contain the "$" character in their names as these are
 166   # special files on some Windows platforms.
 167   #
 168   set res [list]
 169   set root_files [list_root_files]
 170   foreach p $root_files {
 171     if {$::tcl_platform(platform) eq "windows"} {
 172       if {![regexp {\$} $p]} {lappend res $p}
 173     } else {
 174       lappend res "/$p"
 175     }
 176   }
 177   set num_root_files [llength $root_files]
 178   do_test 3.1 {
 179     sort_files [execsql {
 180       SELECT path FROM fstree WHERE path NOT GLOB '*\$*' LIMIT $num_root_files;
 181     }] true
 182   } [sort_files $res true]
 183
 184   # Read all entries in the current directory.
 185   #
 186   proc contents {pattern} {
 187     set res [list]
 188     foreach f [list_files $pattern] {
 189       lappend res $f
 190       if {[file isdir $f]} {
 191         set res [concat $res [contents "$f/*"]]
 192       }
 193     }
 194     set res
 195   }
 196   set pwd "[pwd]/*"
 197   set res [contents $pwd]
 198   do_execsql_test 3.2 {
 199     SELECT path FROM fstree WHERE path GLOB $pwd ORDER BY 1
 200   } [sort_files $res]
 201
 202   # Add some sub-directories and files to the current directory.
 203   #
 204   do_test 3.3 {
 205     catch { file delete -force subdir }
 206     foreach {path sz} {
 207       subdir/x1.txt     143
 208       subdir/x2.txt     153
 209     } {
 210       set dir [file dirname $path]
 211       catch { file mkdir $dir }
 212       set fd [open $path w]
 213       puts -nonewline $fd [string repeat 1 $sz]
 214       close $fd
 215     }
 216   } {}
 217
 218   set pwd [pwd]
 219   if {![string match {*[_%]*} $pwd]} {
 220     do_execsql_test 3.5 {
 221       SELECT path, size FROM fstree
 222        WHERE path GLOB $pwd || '/subdir/*' ORDER BY 1
 223     } [list \
 224       "$pwd/subdir/x1.txt" 143 \
 225       "$pwd/subdir/x2.txt" 153 \
 226     ]
 227     do_execsql_test 3.6 {
 228       SELECT path, size FROM fstree
 229        WHERE path LIKE $pwd || '/subdir/%' ORDER BY 1
 230     } [list \
 231       "$pwd/subdir/x1.txt" 143 \
 232       "$pwd/subdir/x2.txt" 153 \
 233     ]
 234     do_execsql_test 3.7 {
 235       SELECT sum(size) FROM fstree WHERE path LIKE $pwd || '/subdir/%'
 236     } 296
 237     do_execsql_test 3.8 {
 238       SELECT size FROM fstree WHERE path = $pwd || '/subdir/x1.txt'
 239     } 143
 240   }
 241
 242 }
 243
 244
 245 finish_test