src/test_vfs.c

   1 /*
   2 ** 2010 May 05
   3 **
   4 ** The author disclaims copyright to this source code.  In place of
   5 ** a legal notice, here is a blessing:
   6 **
   7 **    May you do good and not evil.
   8 **    May you find forgiveness for yourself and forgive others.
   9 **    May you share freely, never taking more than you give.
  10 **
  11 ******************************************************************************
  12 **
  13 ** This file contains the implementation of the Tcl [testvfs] command,
  14 ** used to create SQLite VFS implementations with various properties and
  15 ** instrumentation to support testing SQLite.
  16 **
  17 **   testvfs VFSNAME ?OPTIONS?
  18 **
  19 ** Available options are:
  20 **
  21 **   -noshm      BOOLEAN        (True to omit shm methods. Default false)
  22 **   -default    BOOLEAN        (True to make the vfs default. Default false)
  23 **   -szosfile   INTEGER        (Value for sqlite3_vfs.szOsFile)
  24 **   -mxpathname INTEGER        (Value for sqlite3_vfs.mxPathname)
  25 **   -iversion   INTEGER        (Value for sqlite3_vfs.iVersion)
  26 */
  27 #if SQLITE_TEST          /* This file is used for testing only */
  28
  29 #include "sqlite3.h"
  30 #include "sqliteInt.h"
  31 #if defined(INCLUDE_SQLITE_TCL_H)
  32 #  include "sqlite_tcl.h"
  33 #else
  34 #  include "tcl.h"
  35 #endif
  36
  37 typedef struct Testvfs Testvfs;
  38 typedef struct TestvfsShm TestvfsShm;
  39 typedef struct TestvfsBuffer TestvfsBuffer;
  40 typedef struct TestvfsFile TestvfsFile;
  41 typedef struct TestvfsFd TestvfsFd;
  42
  43 /*
  44 ** An open file handle.
  45 */
  46 struct TestvfsFile {
  47   sqlite3_file base;              /* Base class.  Must be first */
  48   TestvfsFd *pFd;                 /* File data */
  49 };
  50 #define tvfsGetFd(pFile) (((TestvfsFile *)pFile)->pFd)
  51
  52 struct TestvfsFd {
  53   sqlite3_vfs *pVfs;              /* The VFS */
  54   const char *zFilename;          /* Filename as passed to xOpen() */
  55   sqlite3_file *pReal;            /* The real, underlying file descriptor */
  56   Tcl_Obj *pShmId;                /* Shared memory id for Tcl callbacks */
  57
  58   TestvfsBuffer *pShm;            /* Shared memory buffer */
  59   u32 excllock;                   /* Mask of exclusive locks */
  60   u32 sharedlock;                 /* Mask of shared locks */
  61   TestvfsFd *pNext;               /* Next handle opened on the same file */
  62 };
  63
  64
  65 #define FAULT_INJECT_NONE       0
  66 #define FAULT_INJECT_TRANSIENT  1
  67 #define FAULT_INJECT_PERSISTENT 2
  68
  69 typedef struct TestFaultInject TestFaultInject;
  70 struct TestFaultInject {
  71   int iCnt;                       /* Remaining calls before fault injection */
  72   int eFault;                     /* A FAULT_INJECT_* value */
  73   int nFail;                      /* Number of faults injected */
  74 };
  75
  76 /*
  77 ** An instance of this structure is allocated for each VFS created. The
  78 ** sqlite3_vfs.pAppData field of the VFS structure registered with SQLite
  79 ** is set to point to it.
  80 */
  81 struct Testvfs {
  82   char *zName;                    /* Name of this VFS */
  83   sqlite3_vfs *pParent;           /* The VFS to use for file IO */
  84   sqlite3_vfs *pVfs;              /* The testvfs registered with SQLite */
  85   Tcl_Interp *interp;             /* Interpreter to run script in */
  86   Tcl_Obj *pScript;               /* Script to execute */
  87   TestvfsBuffer *pBuffer;         /* List of shared buffers */
  88   int isNoshm;
  89   int isFullshm;
  90
  91   int mask;                       /* Mask controlling [script] and [ioerr] */
  92
  93   TestFaultInject ioerr_err;
  94   TestFaultInject full_err;
  95   TestFaultInject cantopen_err;
  96
  97 #if 0
  98   int iIoerrCnt;
  99   int ioerr;
 100   int nIoerrFail;
 101   int iFullCnt;
 102   int fullerr;
 103   int nFullFail;
 104 #endif
 105
 106   int iDevchar;
 107   int iSectorsize;
 108 };
 109
 110 /*
 111 ** The Testvfs.mask variable is set to a combination of the following.
 112 ** If a bit is clear in Testvfs.mask, then calls made by SQLite to the
 113 ** corresponding VFS method is ignored for purposes of:
 114 **
 115 **   + Simulating IO errors, and
 116 **   + Invoking the Tcl callback script.
 117 */
 118 #define TESTVFS_SHMOPEN_MASK      0x00000001
 119 #define TESTVFS_SHMLOCK_MASK      0x00000010
 120 #define TESTVFS_SHMMAP_MASK       0x00000020
 121 #define TESTVFS_SHMBARRIER_MASK   0x00000040
 122 #define TESTVFS_SHMCLOSE_MASK     0x00000080
 123
 124 #define TESTVFS_OPEN_MASK         0x00000100
 125 #define TESTVFS_SYNC_MASK         0x00000200
 126 #define TESTVFS_DELETE_MASK       0x00000400
 127 #define TESTVFS_CLOSE_MASK        0x00000800
 128 #define TESTVFS_WRITE_MASK        0x00001000
 129 #define TESTVFS_TRUNCATE_MASK     0x00002000
 130 #define TESTVFS_ACCESS_MASK       0x00004000
 131 #define TESTVFS_FULLPATHNAME_MASK 0x00008000
 132 #define TESTVFS_READ_MASK         0x00010000
 133 #define TESTVFS_UNLOCK_MASK       0x00020000
 134 #define TESTVFS_LOCK_MASK         0x00040000
 135 #define TESTVFS_CKLOCK_MASK       0x00080000
 136 #define TESTVFS_FCNTL_MASK        0x00100000
 137
 138 #define TESTVFS_ALL_MASK          0x001FFFFF
 139
 140
 141 #define TESTVFS_MAX_PAGES 1024
 142
 143 /*
 144 ** A shared-memory buffer. There is one of these objects for each shared
 145 ** memory region opened by clients. If two clients open the same file,
 146 ** there are two TestvfsFile structures but only one TestvfsBuffer structure.
 147 */
 148 struct TestvfsBuffer {
 149   char *zFile;                    /* Associated file name */
 150   int pgsz;                       /* Page size */
 151   u8 *aPage[TESTVFS_MAX_PAGES];   /* Array of ckalloc'd pages */
 152   TestvfsFd *pFile;               /* List of open handles */
 153   TestvfsBuffer *pNext;           /* Next in linked list of all buffers */
 154 };
 155
 156
 157 #define PARENTVFS(x) (((Testvfs *)((x)->pAppData))->pParent)
 158
 159 #define TESTVFS_MAX_ARGS 12
 160
 161
 162 /*
 163 ** Method declarations for TestvfsFile.
 164 */
 165 static int tvfsClose(sqlite3_file*);
 166 static int tvfsRead(sqlite3_file*, void*, int iAmt, sqlite3_int64 iOfst);
 167 static int tvfsWrite(sqlite3_file*,const void*,int iAmt, sqlite3_int64 iOfst);
 168 static int tvfsTruncate(sqlite3_file*, sqlite3_int64 size);
 169 static int tvfsSync(sqlite3_file*, int flags);
 170 static int tvfsFileSize(sqlite3_file*, sqlite3_int64 *pSize);
 171 static int tvfsLock(sqlite3_file*, int);
 172 static int tvfsUnlock(sqlite3_file*, int);
 173 static int tvfsCheckReservedLock(sqlite3_file*, int *);
 174 static int tvfsFileControl(sqlite3_file*, int op, void *pArg);
 175 static int tvfsSectorSize(sqlite3_file*);
 176 static int tvfsDeviceCharacteristics(sqlite3_file*);
 177
 178 /*
 179 ** Method declarations for tvfs_vfs.
 180 */
 181 static int tvfsOpen(sqlite3_vfs*, const char *, sqlite3_file*, int , int *);
 182 static int tvfsDelete(sqlite3_vfs*, const char *zName, int syncDir);
 183 static int tvfsAccess(sqlite3_vfs*, const char *zName, int flags, int *);
 184 static int tvfsFullPathname(sqlite3_vfs*, const char *zName, int, char *zOut);
 185 #ifndef SQLITE_OMIT_LOAD_EXTENSION
 186 static void *tvfsDlOpen(sqlite3_vfs*, const char *zFilename);
 187 static void tvfsDlError(sqlite3_vfs*, int nByte, char *zErrMsg);
 188 static void (*tvfsDlSym(sqlite3_vfs*,void*, const char *zSymbol))(void);
 189 static void tvfsDlClose(sqlite3_vfs*, void*);
 190 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
 191 static int tvfsRandomness(sqlite3_vfs*, int nByte, char *zOut);
 192 static int tvfsSleep(sqlite3_vfs*, int microseconds);
 193 static int tvfsCurrentTime(sqlite3_vfs*, double*);
 194
 195 static int tvfsShmOpen(sqlite3_file*);
 196 static int tvfsShmLock(sqlite3_file*, int , int, int);
 197 static int tvfsShmMap(sqlite3_file*,int,int,int, void volatile **);
 198 static void tvfsShmBarrier(sqlite3_file*);
 199 static int tvfsShmUnmap(sqlite3_file*, int);
 200
 201 static int tvfsFetch(sqlite3_file*, sqlite3_int64, int, void**);
 202 static int tvfsUnfetch(sqlite3_file*, sqlite3_int64, void*);
 203
 204 static sqlite3_io_methods tvfs_io_methods = {
 205   3,                              /* iVersion */
 206   tvfsClose,                      /* xClose */
 207   tvfsRead,                       /* xRead */
 208   tvfsWrite,                      /* xWrite */
 209   tvfsTruncate,                   /* xTruncate */
 210   tvfsSync,                       /* xSync */
 211   tvfsFileSize,                   /* xFileSize */
 212   tvfsLock,                       /* xLock */
 213   tvfsUnlock,                     /* xUnlock */
 214   tvfsCheckReservedLock,          /* xCheckReservedLock */
 215   tvfsFileControl,                /* xFileControl */
 216   tvfsSectorSize,                 /* xSectorSize */
 217   tvfsDeviceCharacteristics,      /* xDeviceCharacteristics */
 218   tvfsShmMap,                     /* xShmMap */
 219   tvfsShmLock,                    /* xShmLock */
 220   tvfsShmBarrier,                 /* xShmBarrier */
 221   tvfsShmUnmap,                   /* xShmUnmap */
 222   tvfsFetch,
 223   tvfsUnfetch
 224 };
 225
 226 static int tvfsResultCode(Testvfs *p, int *pRc){
 227   struct errcode {
 228     int eCode;
 229     const char *zCode;
 230   } aCode[] = {
 231     { SQLITE_OK,       "SQLITE_OK"     },
 232     { SQLITE_ERROR,    "SQLITE_ERROR"  },
 233     { SQLITE_IOERR,    "SQLITE_IOERR"  },
 234     { SQLITE_LOCKED,   "SQLITE_LOCKED" },
 235     { SQLITE_BUSY,     "SQLITE_BUSY"   },
 236     { SQLITE_READONLY, "SQLITE_READONLY"   },
 237     { SQLITE_READONLY_CANTINIT, "SQLITE_READONLY_CANTINIT"   },
 238     { SQLITE_NOTFOUND, "SQLITE_NOTFOUND"   },
 239     { -1,              "SQLITE_OMIT"   },
 240   };
 241
 242   const char *z;
 243   int i;
 244
 245   z = Tcl_GetStringResult(p->interp);
 246   for(i=0; i<ArraySize(aCode); i++){
 247     if( 0==strcmp(z, aCode[i].zCode) ){
 248       *pRc = aCode[i].eCode;
 249       return 1;
 250     }
 251   }
 252
 253   return 0;
 254 }
 255
 256 static int tvfsInjectFault(TestFaultInject *p){
 257   int ret = 0;
 258   if( p->eFault ){
 259     p->iCnt--;
 260     if( p->iCnt==0 || (p->iCnt<0 && p->eFault==FAULT_INJECT_PERSISTENT ) ){
 261       ret = 1;
 262       p->nFail++;
 263     }
 264   }
 265   return ret;
 266 }
 267
 268
 269 static int tvfsInjectIoerr(Testvfs *p){
 270   return tvfsInjectFault(&p->ioerr_err);
 271 }
 272
 273 static int tvfsInjectFullerr(Testvfs *p){
 274   return tvfsInjectFault(&p->full_err);
 275 }
 276 static int tvfsInjectCantopenerr(Testvfs *p){
 277   return tvfsInjectFault(&p->cantopen_err);
 278 }
 279
 280
 281 static void tvfsExecTcl(
 282   Testvfs *p,
 283   const char *zMethod,
 284   Tcl_Obj *arg1,
 285   Tcl_Obj *arg2,
 286   Tcl_Obj *arg3,
 287   Tcl_Obj *arg4
 288 ){
 289   int rc;                         /* Return code from Tcl_EvalObj() */
 290   Tcl_Obj *pEval;
 291   assert( p->pScript );
 292
 293   assert( zMethod );
 294   assert( p );
 295   assert( arg2==0 || arg1!=0 );
 296   assert( arg3==0 || arg2!=0 );
 297
 298   pEval = Tcl_DuplicateObj(p->pScript);
 299   Tcl_IncrRefCount(p->pScript);
 300   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zMethod, -1));
 301   if( arg1 ) Tcl_ListObjAppendElement(p->interp, pEval, arg1);
 302   if( arg2 ) Tcl_ListObjAppendElement(p->interp, pEval, arg2);
 303   if( arg3 ) Tcl_ListObjAppendElement(p->interp, pEval, arg3);
 304   if( arg4 ) Tcl_ListObjAppendElement(p->interp, pEval, arg4);
 305
 306   rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
 307   if( rc!=TCL_OK ){
 308     Tcl_BackgroundError(p->interp);
 309     Tcl_ResetResult(p->interp);
 310   }
 311 }
 312
 313
 314 /*
 315 ** Close an tvfs-file.
 316 */
 317 static int tvfsClose(sqlite3_file *pFile){
 318   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
 319   TestvfsFd *pFd = pTestfile->pFd;
 320   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 321
 322   if( p->pScript && p->mask&TESTVFS_CLOSE_MASK ){
 323     tvfsExecTcl(p, "xClose",
 324         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
 325     );
 326   }
 327
 328   if( pFd->pShmId ){
 329     Tcl_DecrRefCount(pFd->pShmId);
 330     pFd->pShmId = 0;
 331   }
 332   if( pFile->pMethods ){
 333     ckfree((char *)pFile->pMethods);
 334   }
 335   sqlite3OsClose(pFd->pReal);
 336   ckfree((char *)pFd);
 337   pTestfile->pFd = 0;
 338   return SQLITE_OK;
 339 }
 340
 341 /*
 342 ** Read data from an tvfs-file.
 343 */
 344 static int tvfsRead(
 345   sqlite3_file *pFile,
 346   void *zBuf,
 347   int iAmt,
 348   sqlite_int64 iOfst
 349 ){
 350   int rc = SQLITE_OK;
 351   TestvfsFd *pFd = tvfsGetFd(pFile);
 352   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 353   if( p->pScript && p->mask&TESTVFS_READ_MASK ){
 354     tvfsExecTcl(p, "xRead",
 355         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
 356     );
 357     tvfsResultCode(p, &rc);
 358   }
 359   if( rc==SQLITE_OK && p->mask&TESTVFS_READ_MASK && tvfsInjectIoerr(p) ){
 360     rc = SQLITE_IOERR;
 361   }
 362   if( rc==SQLITE_OK ){
 363     rc = sqlite3OsRead(pFd->pReal, zBuf, iAmt, iOfst);
 364   }
 365   return rc;
 366 }
 367
 368 /*
 369 ** Write data to an tvfs-file.
 370 */
 371 static int tvfsWrite(
 372   sqlite3_file *pFile,
 373   const void *zBuf,
 374   int iAmt,
 375   sqlite_int64 iOfst
 376 ){
 377   int rc = SQLITE_OK;
 378   TestvfsFd *pFd = tvfsGetFd(pFile);
 379   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 380
 381   if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){
 382     tvfsExecTcl(p, "xWrite",
 383         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
 384         Tcl_NewWideIntObj(iOfst), Tcl_NewIntObj(iAmt)
 385     );
 386     tvfsResultCode(p, &rc);
 387     if( rc<0 ) return SQLITE_OK;
 388   }
 389
 390   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){
 391     rc = SQLITE_FULL;
 392   }
 393   if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
 394     rc = SQLITE_IOERR;
 395   }
 396
 397   if( rc==SQLITE_OK ){
 398     rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst);
 399   }
 400   return rc;
 401 }
 402
 403 /*
 404 ** Truncate an tvfs-file.
 405 */
 406 static int tvfsTruncate(sqlite3_file *pFile, sqlite_int64 size){
 407   int rc = SQLITE_OK;
 408   TestvfsFd *pFd = tvfsGetFd(pFile);
 409   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 410
 411   if( p->pScript && p->mask&TESTVFS_TRUNCATE_MASK ){
 412     tvfsExecTcl(p, "xTruncate",
 413         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
 414     );
 415     tvfsResultCode(p, &rc);
 416   }
 417
 418   if( rc==SQLITE_OK ){
 419     rc = sqlite3OsTruncate(pFd->pReal, size);
 420   }
 421   return rc;
 422 }
 423
 424 /*
 425 ** Sync an tvfs-file.
 426 */
 427 static int tvfsSync(sqlite3_file *pFile, int flags){
 428   int rc = SQLITE_OK;
 429   TestvfsFd *pFd = tvfsGetFd(pFile);
 430   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 431
 432   if( p->pScript && p->mask&TESTVFS_SYNC_MASK ){
 433     char *zFlags = 0;
 434
 435     switch( flags ){
 436       case SQLITE_SYNC_NORMAL:
 437         zFlags = "normal";
 438         break;
 439       case SQLITE_SYNC_FULL:
 440         zFlags = "full";
 441         break;
 442       case SQLITE_SYNC_NORMAL|SQLITE_SYNC_DATAONLY:
 443         zFlags = "normal|dataonly";
 444         break;
 445       case SQLITE_SYNC_FULL|SQLITE_SYNC_DATAONLY:
 446         zFlags = "full|dataonly";
 447         break;
 448       default:
 449         assert(0);
 450     }
 451
 452     tvfsExecTcl(p, "xSync",
 453         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
 454         Tcl_NewStringObj(zFlags, -1), 0
 455     );
 456     tvfsResultCode(p, &rc);
 457   }
 458
 459   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ) rc = SQLITE_FULL;
 460
 461   if( rc==SQLITE_OK ){
 462     rc = sqlite3OsSync(pFd->pReal, flags);
 463   }
 464
 465   return rc;
 466 }
 467
 468 /*
 469 ** Return the current file-size of an tvfs-file.
 470 */
 471 static int tvfsFileSize(sqlite3_file *pFile, sqlite_int64 *pSize){
 472   TestvfsFd *p = tvfsGetFd(pFile);
 473   return sqlite3OsFileSize(p->pReal, pSize);
 474 }
 475
 476 /*
 477 ** Lock an tvfs-file.
 478 */
 479 static int tvfsLock(sqlite3_file *pFile, int eLock){
 480   TestvfsFd *pFd = tvfsGetFd(pFile);
 481   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 482   if( p->pScript && p->mask&TESTVFS_LOCK_MASK ){
 483     char zLock[30];
 484     sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
 485     tvfsExecTcl(p, "xLock", Tcl_NewStringObj(pFd->zFilename, -1),
 486                    Tcl_NewStringObj(zLock, -1), 0, 0);
 487   }
 488   if( p->mask&TESTVFS_LOCK_MASK && tvfsInjectIoerr(p) ){
 489     return SQLITE_IOERR_LOCK;
 490   }
 491   return sqlite3OsLock(pFd->pReal, eLock);
 492 }
 493
 494 /*
 495 ** Unlock an tvfs-file.
 496 */
 497 static int tvfsUnlock(sqlite3_file *pFile, int eLock){
 498   TestvfsFd *pFd = tvfsGetFd(pFile);
 499   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 500   if( p->pScript && p->mask&TESTVFS_UNLOCK_MASK ){
 501     char zLock[30];
 502     sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
 503     tvfsExecTcl(p, "xUnlock", Tcl_NewStringObj(pFd->zFilename, -1),
 504                    Tcl_NewStringObj(zLock, -1), 0, 0);
 505   }
 506   if( p->mask&TESTVFS_UNLOCK_MASK && tvfsInjectIoerr(p) ){
 507     return SQLITE_IOERR_UNLOCK;
 508   }
 509   return sqlite3OsUnlock(pFd->pReal, eLock);
 510 }
 511
 512 /*
 513 ** Check if another file-handle holds a RESERVED lock on an tvfs-file.
 514 */
 515 static int tvfsCheckReservedLock(sqlite3_file *pFile, int *pResOut){
 516   TestvfsFd *pFd = tvfsGetFd(pFile);
 517   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 518   if( p->pScript && p->mask&TESTVFS_CKLOCK_MASK ){
 519     tvfsExecTcl(p, "xCheckReservedLock", Tcl_NewStringObj(pFd->zFilename, -1),
 520                    0, 0, 0);
 521   }
 522   return sqlite3OsCheckReservedLock(pFd->pReal, pResOut);
 523 }
 524
 525 /*
 526 ** File control method. For custom operations on an tvfs-file.
 527 */
 528 static int tvfsFileControl(sqlite3_file *pFile, int op, void *pArg){
 529   TestvfsFd *pFd = tvfsGetFd(pFile);
 530   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 531   if( op==SQLITE_FCNTL_PRAGMA ){
 532     char **argv = (char**)pArg;
 533     if( sqlite3_stricmp(argv[1],"error")==0 ){
 534       int rc = SQLITE_ERROR;
 535       if( argv[2] ){
 536         const char *z = argv[2];
 537         int x = atoi(z);
 538         if( x ){
 539           rc = x;
 540           while( sqlite3Isdigit(z[0]) ){ z++; }
 541           while( sqlite3Isspace(z[0]) ){ z++; }
 542         }
 543         if( z[0] ) argv[0] = sqlite3_mprintf("%s", z);
 544       }
 545       return rc;
 546     }
 547     if( sqlite3_stricmp(argv[1], "filename")==0 ){
 548       argv[0] = sqlite3_mprintf("%s", pFd->zFilename);
 549       return SQLITE_OK;
 550     }
 551   }
 552   if( p->pScript && (p->mask&TESTVFS_FCNTL_MASK) ){
 553     struct Fcntl {
 554       int iFnctl;
 555       const char *zFnctl;
 556     } aF[] = {
 557       { SQLITE_FCNTL_BEGIN_ATOMIC_WRITE, "BEGIN_ATOMIC_WRITE" },
 558       { SQLITE_FCNTL_COMMIT_ATOMIC_WRITE, "COMMIT_ATOMIC_WRITE" },
 559       { SQLITE_FCNTL_ZIPVFS, "ZIPVFS" },
 560     };
 561     int i;
 562     for(i=0; i<sizeof(aF)/sizeof(aF[0]); i++){
 563       if( op==aF[i].iFnctl ) break;
 564     }
 565     if( i<sizeof(aF)/sizeof(aF[0]) ){
 566       int rc = 0;
 567       tvfsExecTcl(p, "xFileControl",
 568           Tcl_NewStringObj(pFd->zFilename, -1),
 569           Tcl_NewStringObj(aF[i].zFnctl, -1),
 570           0, 0
 571       );
 572       tvfsResultCode(p, &rc);
 573       if( rc ) return (rc<0 ? SQLITE_OK : rc);
 574     }
 575   }
 576   return sqlite3OsFileControl(pFd->pReal, op, pArg);
 577 }
 578
 579 /*
 580 ** Return the sector-size in bytes for an tvfs-file.
 581 */
 582 static int tvfsSectorSize(sqlite3_file *pFile){
 583   TestvfsFd *pFd = tvfsGetFd(pFile);
 584   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 585   if( p->iSectorsize>=0 ){
 586     return p->iSectorsize;
 587   }
 588   return sqlite3OsSectorSize(pFd->pReal);
 589 }
 590
 591 /*
 592 ** Return the device characteristic flags supported by an tvfs-file.
 593 */
 594 static int tvfsDeviceCharacteristics(sqlite3_file *pFile){
 595   TestvfsFd *pFd = tvfsGetFd(pFile);
 596   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
 597   if( p->iDevchar>=0 ){
 598     return p->iDevchar;
 599   }
 600   return sqlite3OsDeviceCharacteristics(pFd->pReal);
 601 }
 602
 603 /*
 604 ** Open an tvfs file handle.
 605 */
 606 static int tvfsOpen(
 607   sqlite3_vfs *pVfs,
 608   const char *zName,
 609   sqlite3_file *pFile,
 610   int flags,
 611   int *pOutFlags
 612 ){
 613   int rc;
 614   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
 615   TestvfsFd *pFd;
 616   Tcl_Obj *pId = 0;
 617   Testvfs *p = (Testvfs *)pVfs->pAppData;
 618
 619   pFd = (TestvfsFd *)ckalloc(sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
 620   memset(pFd, 0, sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
 621   pFd->pShm = 0;
 622   pFd->pShmId = 0;
 623   pFd->zFilename = zName;
 624   pFd->pVfs = pVfs;
 625   pFd->pReal = (sqlite3_file *)&pFd[1];
 626   memset(pTestfile, 0, sizeof(TestvfsFile));
 627   pTestfile->pFd = pFd;
 628
 629   /* Evaluate the Tcl script:
 630   **
 631   **   SCRIPT xOpen FILENAME KEY-VALUE-ARGS
 632   **
 633   ** If the script returns an SQLite error code other than SQLITE_OK, an
 634   ** error is returned to the caller. If it returns SQLITE_OK, the new
 635   ** connection is named "anon". Otherwise, the value returned by the
 636   ** script is used as the connection name.
 637   */
 638   Tcl_ResetResult(p->interp);
 639   if( p->pScript && p->mask&TESTVFS_OPEN_MASK ){
 640     Tcl_Obj *pArg = Tcl_NewObj();
 641     Tcl_IncrRefCount(pArg);
 642     if( flags&SQLITE_OPEN_MAIN_DB ){
 643       const char *z = &zName[strlen(zName)+1];
 644       while( *z ){
 645         Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
 646         z += strlen(z) + 1;
 647         Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
 648         z += strlen(z) + 1;
 649       }
 650     }
 651     tvfsExecTcl(p, "xOpen", Tcl_NewStringObj(pFd->zFilename, -1), pArg, 0, 0);
 652     Tcl_DecrRefCount(pArg);
 653     if( tvfsResultCode(p, &rc) ){
 654       if( rc!=SQLITE_OK ) return rc;
 655     }else{
 656       pId = Tcl_GetObjResult(p->interp);
 657     }
 658   }
 659
 660   if( (p->mask&TESTVFS_OPEN_MASK) &&  tvfsInjectIoerr(p) ) return SQLITE_IOERR;
 661   if( tvfsInjectCantopenerr(p) ) return SQLITE_CANTOPEN;
 662   if( tvfsInjectFullerr(p) ) return SQLITE_FULL;
 663
 664   if( !pId ){
 665     pId = Tcl_NewStringObj("anon", -1);
 666   }
 667   Tcl_IncrRefCount(pId);
 668   pFd->pShmId = pId;
 669   Tcl_ResetResult(p->interp);
 670
 671   rc = sqlite3OsOpen(PARENTVFS(pVfs), zName, pFd->pReal, flags, pOutFlags);
 672   if( pFd->pReal->pMethods ){
 673     sqlite3_io_methods *pMethods;
 674     int nByte;
 675
 676     if( pVfs->iVersion>1 ){
 677       nByte = sizeof(sqlite3_io_methods);
 678     }else{
 679       nByte = offsetof(sqlite3_io_methods, xShmMap);
 680     }
 681
 682     pMethods = (sqlite3_io_methods *)ckalloc(nByte);
 683     memcpy(pMethods, &tvfs_io_methods, nByte);
 684     pMethods->iVersion = pFd->pReal->pMethods->iVersion;
 685     if( pMethods->iVersion>pVfs->iVersion ){
 686       pMethods->iVersion = pVfs->iVersion;
 687     }
 688     if( pVfs->iVersion>1 && ((Testvfs *)pVfs->pAppData)->isNoshm ){
 689       pMethods->xShmUnmap = 0;
 690       pMethods->xShmLock = 0;
 691       pMethods->xShmBarrier = 0;
 692       pMethods->xShmMap = 0;
 693     }
 694     pFile->pMethods = pMethods;
 695   }
 696
 697   return rc;
 698 }
 699
 700 /*
 701 ** Delete the file located at zPath. If the dirSync argument is true,
 702 ** ensure the file-system modifications are synced to disk before
 703 ** returning.
 704 */
 705 static int tvfsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){
 706   int rc = SQLITE_OK;
 707   Testvfs *p = (Testvfs *)pVfs->pAppData;
 708
 709   if( p->pScript && p->mask&TESTVFS_DELETE_MASK ){
 710     tvfsExecTcl(p, "xDelete",
 711         Tcl_NewStringObj(zPath, -1), Tcl_NewIntObj(dirSync), 0, 0
 712     );
 713     tvfsResultCode(p, &rc);
 714   }
 715   if( rc==SQLITE_OK ){
 716     rc = sqlite3OsDelete(PARENTVFS(pVfs), zPath, dirSync);
 717   }
 718   return rc;
 719 }
 720
 721 /*
 722 ** Test for access permissions. Return true if the requested permission
 723 ** is available, or false otherwise.
 724 */
 725 static int tvfsAccess(
 726   sqlite3_vfs *pVfs,
 727   const char *zPath,
 728   int flags,
 729   int *pResOut
 730 ){
 731   Testvfs *p = (Testvfs *)pVfs->pAppData;
 732   if( p->pScript && p->mask&TESTVFS_ACCESS_MASK ){
 733     int rc;
 734     char *zArg = 0;
 735     if( flags==SQLITE_ACCESS_EXISTS ) zArg = "SQLITE_ACCESS_EXISTS";
 736     if( flags==SQLITE_ACCESS_READWRITE ) zArg = "SQLITE_ACCESS_READWRITE";
 737     if( flags==SQLITE_ACCESS_READ ) zArg = "SQLITE_ACCESS_READ";
 738     tvfsExecTcl(p, "xAccess",
 739         Tcl_NewStringObj(zPath, -1), Tcl_NewStringObj(zArg, -1), 0, 0
 740     );
 741     if( tvfsResultCode(p, &rc) ){
 742       if( rc!=SQLITE_OK ) return rc;
 743     }else{
 744       Tcl_Interp *interp = p->interp;
 745       if( TCL_OK==Tcl_GetBooleanFromObj(0, Tcl_GetObjResult(interp), pResOut) ){
 746         return SQLITE_OK;
 747       }
 748     }
 749   }
 750   return sqlite3OsAccess(PARENTVFS(pVfs), zPath, flags, pResOut);
 751 }
 752
 753 /*
 754 ** Populate buffer zOut with the full canonical pathname corresponding
 755 ** to the pathname in zPath. zOut is guaranteed to point to a buffer
 756 ** of at least (DEVSYM_MAX_PATHNAME+1) bytes.
 757 */
 758 static int tvfsFullPathname(
 759   sqlite3_vfs *pVfs,
 760   const char *zPath,
 761   int nOut,
 762   char *zOut
 763 ){
 764   Testvfs *p = (Testvfs *)pVfs->pAppData;
 765   if( p->pScript && p->mask&TESTVFS_FULLPATHNAME_MASK ){
 766     int rc;
 767     tvfsExecTcl(p, "xFullPathname", Tcl_NewStringObj(zPath, -1), 0, 0, 0);
 768     if( tvfsResultCode(p, &rc) ){
 769       if( rc!=SQLITE_OK ) return rc;
 770     }
 771   }
 772   return sqlite3OsFullPathname(PARENTVFS(pVfs), zPath, nOut, zOut);
 773 }
 774
 775 #ifndef SQLITE_OMIT_LOAD_EXTENSION
 776 /*
 777 ** Open the dynamic library located at zPath and return a handle.
 778 */
 779 static void *tvfsDlOpen(sqlite3_vfs *pVfs, const char *zPath){
 780   return sqlite3OsDlOpen(PARENTVFS(pVfs), zPath);
 781 }
 782
 783 /*
 784 ** Populate the buffer zErrMsg (size nByte bytes) with a human readable
 785 ** utf-8 string describing the most recent error encountered associated
 786 ** with dynamic libraries.
 787 */
 788 static void tvfsDlError(sqlite3_vfs *pVfs, int nByte, char *zErrMsg){
 789   sqlite3OsDlError(PARENTVFS(pVfs), nByte, zErrMsg);
 790 }
 791
 792 /*
 793 ** Return a pointer to the symbol zSymbol in the dynamic library pHandle.
 794 */
 795 static void (*tvfsDlSym(sqlite3_vfs *pVfs, void *p, const char *zSym))(void){
 796   return sqlite3OsDlSym(PARENTVFS(pVfs), p, zSym);
 797 }
 798
 799 /*
 800 ** Close the dynamic library handle pHandle.
 801 */
 802 static void tvfsDlClose(sqlite3_vfs *pVfs, void *pHandle){
 803   sqlite3OsDlClose(PARENTVFS(pVfs), pHandle);
 804 }
 805 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
 806
 807 /*
 808 ** Populate the buffer pointed to by zBufOut with nByte bytes of
 809 ** random data.
 810 */
 811 static int tvfsRandomness(sqlite3_vfs *pVfs, int nByte, char *zBufOut){
 812   return sqlite3OsRandomness(PARENTVFS(pVfs), nByte, zBufOut);
 813 }
 814
 815 /*
 816 ** Sleep for nMicro microseconds. Return the number of microseconds
 817 ** actually slept.
 818 */
 819 static int tvfsSleep(sqlite3_vfs *pVfs, int nMicro){
 820   return sqlite3OsSleep(PARENTVFS(pVfs), nMicro);
 821 }
 822
 823 /*
 824 ** Return the current time as a Julian Day number in *pTimeOut.
 825 */
 826 static int tvfsCurrentTime(sqlite3_vfs *pVfs, double *pTimeOut){
 827   return PARENTVFS(pVfs)->xCurrentTime(PARENTVFS(pVfs), pTimeOut);
 828 }
 829
 830 static int tvfsShmOpen(sqlite3_file *pFile){
 831   Testvfs *p;
 832   int rc = SQLITE_OK;             /* Return code */
 833   TestvfsBuffer *pBuffer;         /* Buffer to open connection to */
 834   TestvfsFd *pFd;                 /* The testvfs file structure */
 835
 836   pFd = tvfsGetFd(pFile);
 837   p = (Testvfs *)pFd->pVfs->pAppData;
 838   assert( 0==p->isFullshm );
 839   assert( pFd->pShmId && pFd->pShm==0 && pFd->pNext==0 );
 840
 841   /* Evaluate the Tcl script:
 842   **
 843   **   SCRIPT xShmOpen FILENAME
 844   */
 845   Tcl_ResetResult(p->interp);
 846   if( p->pScript && p->mask&TESTVFS_SHMOPEN_MASK ){
 847     tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0, 0);
 848     if( tvfsResultCode(p, &rc) ){
 849       if( rc!=SQLITE_OK ) return rc;
 850     }
 851   }
 852
 853   assert( rc==SQLITE_OK );
 854   if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
 855     return SQLITE_IOERR;
 856   }
 857
 858   /* Search for a TestvfsBuffer. Create a new one if required. */
 859   for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
 860     if( 0==strcmp(pFd->zFilename, pBuffer->zFile) ) break;
 861   }
 862   if( !pBuffer ){
 863     int szName = (int)strlen(pFd->zFilename);
 864     int nByte = sizeof(TestvfsBuffer) + szName + 1;
 865     pBuffer = (TestvfsBuffer *)ckalloc(nByte);
 866     memset(pBuffer, 0, nByte);
 867     pBuffer->zFile = (char *)&pBuffer[1];
 868     memcpy(pBuffer->zFile, pFd->zFilename, szName+1);
 869     pBuffer->pNext = p->pBuffer;
 870     p->pBuffer = pBuffer;
 871   }
 872
 873   /* Connect the TestvfsBuffer to the new TestvfsShm handle and return. */
 874   pFd->pNext = pBuffer->pFile;
 875   pBuffer->pFile = pFd;
 876   pFd->pShm = pBuffer;
 877   return rc;
 878 }
 879
 880 static void tvfsAllocPage(TestvfsBuffer *p, int iPage, int pgsz){
 881   assert( iPage<TESTVFS_MAX_PAGES );
 882   if( p->aPage[iPage]==0 ){
 883     p->aPage[iPage] = (u8 *)ckalloc(pgsz);
 884     memset(p->aPage[iPage], 0, pgsz);
 885     p->pgsz = pgsz;
 886   }
 887 }
 888
 889 static int tvfsShmMap(
 890   sqlite3_file *pFile,            /* Handle open on database file */
 891   int iPage,                      /* Page to retrieve */
 892   int pgsz,                       /* Size of pages */
 893   int isWrite,                    /* True to extend file if necessary */
 894   void volatile **pp              /* OUT: Mapped memory */
 895 ){
 896   int rc = SQLITE_OK;
 897   TestvfsFd *pFd = tvfsGetFd(pFile);
 898   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
 899
 900   if( p->isFullshm ){
 901     sqlite3_file *pReal = pFd->pReal;
 902     return pReal->pMethods->xShmMap(pReal, iPage, pgsz, isWrite, pp);
 903   }
 904
 905   if( 0==pFd->pShm ){
 906     rc = tvfsShmOpen(pFile);
 907     if( rc!=SQLITE_OK ){
 908       return rc;
 909     }
 910   }
 911
 912   if( p->pScript && p->mask&TESTVFS_SHMMAP_MASK ){
 913     Tcl_Obj *pArg = Tcl_NewObj();
 914     Tcl_IncrRefCount(pArg);
 915     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(iPage));
 916     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(pgsz));
 917     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(isWrite));
 918     tvfsExecTcl(p, "xShmMap",
 919         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, pArg, 0
 920     );
 921     tvfsResultCode(p, &rc);
 922     Tcl_DecrRefCount(pArg);
 923   }
 924   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMMAP_MASK && tvfsInjectIoerr(p) ){
 925     rc = SQLITE_IOERR;
 926   }
 927
 928   if( rc==SQLITE_OK && isWrite && !pFd->pShm->aPage[iPage] ){
 929     tvfsAllocPage(pFd->pShm, iPage, pgsz);
 930   }
 931   if( rc==SQLITE_OK || rc==SQLITE_READONLY ){
 932     *pp = (void volatile *)pFd->pShm->aPage[iPage];
 933   }
 934
 935   return rc;
 936 }
 937
 938
 939 static int tvfsShmLock(
 940   sqlite3_file *pFile,
 941   int ofst,
 942   int n,
 943   int flags
 944 ){
 945   int rc = SQLITE_OK;
 946   TestvfsFd *pFd = tvfsGetFd(pFile);
 947   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
 948   int nLock;
 949   char zLock[80];
 950
 951   if( p->isFullshm ){
 952     sqlite3_file *pReal = pFd->pReal;
 953     return pReal->pMethods->xShmLock(pReal, ofst, n, flags);
 954   }
 955
 956   if( p->pScript && p->mask&TESTVFS_SHMLOCK_MASK ){
 957     sqlite3_snprintf(sizeof(zLock), zLock, "%d %d", ofst, n);
 958     nLock = (int)strlen(zLock);
 959     if( flags & SQLITE_SHM_LOCK ){
 960       strcpy(&zLock[nLock], " lock");
 961     }else{
 962       strcpy(&zLock[nLock], " unlock");
 963     }
 964     nLock += (int)strlen(&zLock[nLock]);
 965     if( flags & SQLITE_SHM_SHARED ){
 966       strcpy(&zLock[nLock], " shared");
 967     }else{
 968       strcpy(&zLock[nLock], " exclusive");
 969     }
 970     tvfsExecTcl(p, "xShmLock",
 971         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId,
 972         Tcl_NewStringObj(zLock, -1), 0
 973     );
 974     tvfsResultCode(p, &rc);
 975   }
 976
 977   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMLOCK_MASK && tvfsInjectIoerr(p) ){
 978     rc = SQLITE_IOERR;
 979   }
 980
 981   if( rc==SQLITE_OK ){
 982     int isLock = (flags & SQLITE_SHM_LOCK);
 983     int isExcl = (flags & SQLITE_SHM_EXCLUSIVE);
 984     u32 mask = (((1<<n)-1) << ofst);
 985     if( isLock ){
 986       TestvfsFd *p2;
 987       for(p2=pFd->pShm->pFile; p2; p2=p2->pNext){
 988         if( p2==pFd ) continue;
 989         if( (p2->excllock&mask) || (isExcl && p2->sharedlock&mask) ){
 990           rc = SQLITE_BUSY;
 991           break;
 992         }
 993       }
 994       if( rc==SQLITE_OK ){
 995         if( isExcl )  pFd->excllock |= mask;
 996         if( !isExcl ) pFd->sharedlock |= mask;
 997       }
 998     }else{
 999       if( isExcl )  pFd->excllock &= (~mask);
1000       if( !isExcl ) pFd->sharedlock &= (~mask);
1001     }
1002   }
1003
1004   return rc;
1005 }
1006
1007 static void tvfsShmBarrier(sqlite3_file *pFile){
1008   TestvfsFd *pFd = tvfsGetFd(pFile);
1009   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
1010
1011   if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
1012     const char *z = pFd->pShm ? pFd->pShm->zFile : "";
1013     tvfsExecTcl(p, "xShmBarrier", Tcl_NewStringObj(z, -1), pFd->pShmId, 0, 0);
1014   }
1015
1016   if( p->isFullshm ){
1017     sqlite3_file *pReal = pFd->pReal;
1018     pReal->pMethods->xShmBarrier(pReal);
1019     return;
1020   }
1021 }
1022
1023 static int tvfsShmUnmap(
1024   sqlite3_file *pFile,
1025   int deleteFlag
1026 ){
1027   int rc = SQLITE_OK;
1028   TestvfsFd *pFd = tvfsGetFd(pFile);
1029   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
1030   TestvfsBuffer *pBuffer = pFd->pShm;
1031   TestvfsFd **ppFd;
1032
1033   if( p->isFullshm ){
1034     sqlite3_file *pReal = pFd->pReal;
1035     return pReal->pMethods->xShmUnmap(pReal, deleteFlag);
1036   }
1037
1038   if( !pBuffer ) return SQLITE_OK;
1039   assert( pFd->pShmId && pFd->pShm );
1040
1041   if( p->pScript && p->mask&TESTVFS_SHMCLOSE_MASK ){
1042     tvfsExecTcl(p, "xShmUnmap",
1043         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0, 0
1044     );
1045     tvfsResultCode(p, &rc);
1046   }
1047
1048   for(ppFd=&pBuffer->pFile; *ppFd!=pFd; ppFd=&((*ppFd)->pNext));
1049   assert( (*ppFd)==pFd );
1050   *ppFd = pFd->pNext;
1051   pFd->pNext = 0;
1052
1053   if( pBuffer->pFile==0 ){
1054     int i;
1055     TestvfsBuffer **pp;
1056     for(pp=&p->pBuffer; *pp!=pBuffer; pp=&((*pp)->pNext));
1057     *pp = (*pp)->pNext;
1058     for(i=0; pBuffer->aPage[i]; i++){
1059       ckfree((char *)pBuffer->aPage[i]);
1060     }
1061     ckfree((char *)pBuffer);
1062   }
1063   pFd->pShm = 0;
1064
1065   return rc;
1066 }
1067
1068 static int tvfsFetch(
1069     sqlite3_file *pFile,
1070     sqlite3_int64 iOfst,
1071     int iAmt,
1072     void **pp
1073 ){
1074   TestvfsFd *pFd = tvfsGetFd(pFile);
1075   return sqlite3OsFetch(pFd->pReal, iOfst, iAmt, pp);
1076 }
1077
1078 static int tvfsUnfetch(sqlite3_file *pFile, sqlite3_int64 iOfst, void *p){
1079   TestvfsFd *pFd = tvfsGetFd(pFile);
1080   return sqlite3OsUnfetch(pFd->pReal, iOfst, p);
1081 }
1082
1083 static int SQLITE_TCLAPI testvfs_obj_cmd(
1084   ClientData cd,
1085   Tcl_Interp *interp,
1086   int objc,
1087   Tcl_Obj *CONST objv[]
1088 ){
1089   Testvfs *p = (Testvfs *)cd;
1090
1091   enum DB_enum {
1092     CMD_SHM, CMD_DELETE, CMD_FILTER, CMD_IOERR, CMD_SCRIPT,
1093     CMD_DEVCHAR, CMD_SECTORSIZE, CMD_FULLERR, CMD_CANTOPENERR
1094   };
1095   struct TestvfsSubcmd {
1096     char *zName;
1097     enum DB_enum eCmd;
1098   } aSubcmd[] = {
1099     { "shm",         CMD_SHM         },
1100     { "delete",      CMD_DELETE      },
1101     { "filter",      CMD_FILTER      },
1102     { "ioerr",       CMD_IOERR       },
1103     { "fullerr",     CMD_FULLERR     },
1104     { "cantopenerr", CMD_CANTOPENERR },
1105     { "script",      CMD_SCRIPT      },
1106     { "devchar",     CMD_DEVCHAR     },
1107     { "sectorsize",  CMD_SECTORSIZE  },
1108     { 0, 0 }
1109   };
1110   int i;
1111
1112   if( objc<2 ){
1113     Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1114     return TCL_ERROR;
1115   }
1116   if( Tcl_GetIndexFromObjStruct(
1117         interp, objv[1], aSubcmd, sizeof(aSubcmd[0]), "subcommand", 0, &i)
1118   ){
1119     return TCL_ERROR;
1120   }
1121   Tcl_ResetResult(interp);
1122
1123   switch( aSubcmd[i].eCmd ){
1124     case CMD_SHM: {
1125       Tcl_Obj *pObj;
1126       int rc;
1127       TestvfsBuffer *pBuffer;
1128       char *zName;
1129       if( objc!=3 && objc!=4 ){
1130         Tcl_WrongNumArgs(interp, 2, objv, "FILE ?VALUE?");
1131         return TCL_ERROR;
1132       }
1133       zName = ckalloc(p->pParent->mxPathname);
1134       rc = p->pParent->xFullPathname(
1135           p->pParent, Tcl_GetString(objv[2]),
1136           p->pParent->mxPathname, zName
1137       );
1138       if( rc!=SQLITE_OK ){
1139         Tcl_AppendResult(interp, "failed to get full path: ",
1140                          Tcl_GetString(objv[2]), 0);
1141         ckfree(zName);
1142         return TCL_ERROR;
1143       }
1144       for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
1145         if( 0==strcmp(pBuffer->zFile, zName) ) break;
1146       }
1147       ckfree(zName);
1148       if( !pBuffer ){
1149         Tcl_AppendResult(interp, "no such file: ", Tcl_GetString(objv[2]), 0);
1150         return TCL_ERROR;
1151       }
1152       if( objc==4 ){
1153         int n;
1154         u8 *a = Tcl_GetByteArrayFromObj(objv[3], &n);
1155         int pgsz = pBuffer->pgsz;
1156         if( pgsz==0 ) pgsz = 65536;
1157         for(i=0; i*pgsz<n; i++){
1158           int nByte = pgsz;
1159           tvfsAllocPage(pBuffer, i, pgsz);
1160           if( n-i*pgsz<pgsz ){
1161             nByte = n;
1162           }
1163           memcpy(pBuffer->aPage[i], &a[i*pgsz], nByte);
1164         }
1165       }
1166
1167       pObj = Tcl_NewObj();
1168       for(i=0; pBuffer->aPage[i]; i++){
1169         int pgsz = pBuffer->pgsz;
1170         if( pgsz==0 ) pgsz = 65536;
1171         Tcl_AppendObjToObj(pObj, Tcl_NewByteArrayObj(pBuffer->aPage[i], pgsz));
1172       }
1173       Tcl_SetObjResult(interp, pObj);
1174       break;
1175     }
1176
1177     /*  TESTVFS filter METHOD-LIST
1178     **
1179     **     Activate special processing for those methods contained in the list
1180     */
1181     case CMD_FILTER: {
1182       static struct VfsMethod {
1183         char *zName;
1184         int mask;
1185       } vfsmethod [] = {
1186         { "xShmOpen",           TESTVFS_SHMOPEN_MASK },
1187         { "xShmLock",           TESTVFS_SHMLOCK_MASK },
1188         { "xShmBarrier",        TESTVFS_SHMBARRIER_MASK },
1189         { "xShmUnmap",          TESTVFS_SHMCLOSE_MASK },
1190         { "xShmMap",            TESTVFS_SHMMAP_MASK },
1191         { "xSync",              TESTVFS_SYNC_MASK },
1192         { "xDelete",            TESTVFS_DELETE_MASK },
1193         { "xWrite",             TESTVFS_WRITE_MASK },
1194         { "xRead",              TESTVFS_READ_MASK },
1195         { "xTruncate",          TESTVFS_TRUNCATE_MASK },
1196         { "xOpen",              TESTVFS_OPEN_MASK },
1197         { "xClose",             TESTVFS_CLOSE_MASK },
1198         { "xAccess",            TESTVFS_ACCESS_MASK },
1199         { "xFullPathname",      TESTVFS_FULLPATHNAME_MASK },
1200         { "xUnlock",            TESTVFS_UNLOCK_MASK },
1201         { "xLock",              TESTVFS_LOCK_MASK },
1202         { "xCheckReservedLock", TESTVFS_CKLOCK_MASK },
1203         { "xFileControl",       TESTVFS_FCNTL_MASK },
1204       };
1205       Tcl_Obj **apElem = 0;
1206       int nElem = 0;
1207       int mask = 0;
1208       if( objc!=3 ){
1209         Tcl_WrongNumArgs(interp, 2, objv, "LIST");
1210         return TCL_ERROR;
1211       }
1212       if( Tcl_ListObjGetElements(interp, objv[2], &nElem, &apElem) ){
1213         return TCL_ERROR;
1214       }
1215       Tcl_ResetResult(interp);
1216       for(i=0; i<nElem; i++){
1217         int iMethod;
1218         char *zElem = Tcl_GetString(apElem[i]);
1219         for(iMethod=0; iMethod<ArraySize(vfsmethod); iMethod++){
1220           if( strcmp(zElem, vfsmethod[iMethod].zName)==0 ){
1221             mask |= vfsmethod[iMethod].mask;
1222             break;
1223           }
1224         }
1225         if( iMethod==ArraySize(vfsmethod) ){
1226           Tcl_AppendResult(interp, "unknown method: ", zElem, 0);
1227           return TCL_ERROR;
1228         }
1229       }
1230       p->mask = mask;
1231       break;
1232     }
1233
1234     /*
1235     **  TESTVFS script ?SCRIPT?
1236     **
1237     **  Query or set the script to be run when filtered VFS events
1238     **  occur.
1239     */
1240     case CMD_SCRIPT: {
1241       if( objc==3 ){
1242         int nByte;
1243         if( p->pScript ){
1244           Tcl_DecrRefCount(p->pScript);
1245           p->pScript = 0;
1246         }
1247         Tcl_GetStringFromObj(objv[2], &nByte);
1248         if( nByte>0 ){
1249           p->pScript = Tcl_DuplicateObj(objv[2]);
1250           Tcl_IncrRefCount(p->pScript);
1251         }
1252       }else if( objc!=2 ){
1253         Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
1254         return TCL_ERROR;
1255       }
1256
1257       Tcl_ResetResult(interp);
1258       if( p->pScript ) Tcl_SetObjResult(interp, p->pScript);
1259
1260       break;
1261     }
1262
1263     /*
1264     ** TESTVFS ioerr ?IFAIL PERSIST?
1265     **
1266     **   Where IFAIL is an integer and PERSIST is boolean.
1267     */
1268     case CMD_CANTOPENERR:
1269     case CMD_IOERR:
1270     case CMD_FULLERR: {
1271       TestFaultInject *pTest = 0;
1272       int iRet;
1273
1274       switch( aSubcmd[i].eCmd ){
1275         case CMD_IOERR: pTest = &p->ioerr_err; break;
1276         case CMD_FULLERR: pTest = &p->full_err; break;
1277         case CMD_CANTOPENERR: pTest = &p->cantopen_err; break;
1278         default: assert(0);
1279       }
1280       iRet = pTest->nFail;
1281       pTest->nFail = 0;
1282       pTest->eFault = 0;
1283       pTest->iCnt = 0;
1284
1285       if( objc==4 ){
1286         int iCnt, iPersist;
1287         if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &iCnt)
1288          || TCL_OK!=Tcl_GetBooleanFromObj(interp, objv[3], &iPersist)
1289         ){
1290           return TCL_ERROR;
1291         }
1292         pTest->eFault = iPersist?FAULT_INJECT_PERSISTENT:FAULT_INJECT_TRANSIENT;
1293         pTest->iCnt = iCnt;
1294       }else if( objc!=2 ){
1295         Tcl_WrongNumArgs(interp, 2, objv, "?CNT PERSIST?");
1296         return TCL_ERROR;
1297       }
1298       Tcl_SetObjResult(interp, Tcl_NewIntObj(iRet));
1299       break;
1300     }
1301
1302     case CMD_DELETE: {
1303       Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
1304       break;
1305     }
1306
1307     case CMD_DEVCHAR: {
1308       struct DeviceFlag {
1309         char *zName;
1310         int iValue;
1311       } aFlag[] = {
1312         { "default",               -1 },
1313         { "atomic",                SQLITE_IOCAP_ATOMIC                },
1314         { "atomic512",             SQLITE_IOCAP_ATOMIC512             },
1315         { "atomic1k",              SQLITE_IOCAP_ATOMIC1K              },
1316         { "atomic2k",              SQLITE_IOCAP_ATOMIC2K              },
1317         { "atomic4k",              SQLITE_IOCAP_ATOMIC4K              },
1318         { "atomic8k",              SQLITE_IOCAP_ATOMIC8K              },
1319         { "atomic16k",             SQLITE_IOCAP_ATOMIC16K             },
1320         { "atomic32k",             SQLITE_IOCAP_ATOMIC32K             },
1321         { "atomic64k",             SQLITE_IOCAP_ATOMIC64K             },
1322         { "sequential",            SQLITE_IOCAP_SEQUENTIAL            },
1323         { "safe_append",           SQLITE_IOCAP_SAFE_APPEND           },
1324         { "undeletable_when_open", SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN },
1325         { "powersafe_overwrite",   SQLITE_IOCAP_POWERSAFE_OVERWRITE   },
1326         { "immutable",             SQLITE_IOCAP_IMMUTABLE             },
1327         { 0, 0 }
1328       };
1329       Tcl_Obj *pRet;
1330       int iFlag;
1331
1332       if( objc>3 ){
1333         Tcl_WrongNumArgs(interp, 2, objv, "?ATTR-LIST?");
1334         return TCL_ERROR;
1335       }
1336       if( objc==3 ){
1337         int j;
1338         int iNew = 0;
1339         Tcl_Obj **flags = 0;
1340         int nFlags = 0;
1341
1342         if( Tcl_ListObjGetElements(interp, objv[2], &nFlags, &flags) ){
1343           return TCL_ERROR;
1344         }
1345
1346         for(j=0; j<nFlags; j++){
1347           int idx = 0;
1348           if( Tcl_GetIndexFromObjStruct(interp, flags[j], aFlag,
1349                 sizeof(aFlag[0]), "flag", 0, &idx)
1350           ){
1351             return TCL_ERROR;
1352           }
1353           if( aFlag[idx].iValue<0 && nFlags>1 ){
1354             Tcl_AppendResult(interp, "bad flags: ", Tcl_GetString(objv[2]), 0);
1355             return TCL_ERROR;
1356           }
1357           iNew |= aFlag[idx].iValue;
1358         }
1359
1360         p->iDevchar = iNew| 0x10000000;
1361       }
1362
1363       pRet = Tcl_NewObj();
1364       for(iFlag=0; iFlag<sizeof(aFlag)/sizeof(aFlag[0]); iFlag++){
1365         if( p->iDevchar & aFlag[iFlag].iValue ){
1366           Tcl_ListObjAppendElement(
1367               interp, pRet, Tcl_NewStringObj(aFlag[iFlag].zName, -1)
1368           );
1369         }
1370       }
1371       Tcl_SetObjResult(interp, pRet);
1372
1373       break;
1374     }
1375
1376     case CMD_SECTORSIZE: {
1377       if( objc>3 ){
1378         Tcl_WrongNumArgs(interp, 2, objv, "?VALUE?");
1379         return TCL_ERROR;
1380       }
1381       if( objc==3 ){
1382         int iNew = 0;
1383         if( Tcl_GetIntFromObj(interp, objv[2], &iNew) ){
1384           return TCL_ERROR;
1385         }
1386         p->iSectorsize = iNew;
1387       }
1388       Tcl_SetObjResult(interp, Tcl_NewIntObj(p->iSectorsize));
1389       break;
1390     }
1391   }
1392
1393   return TCL_OK;
1394 }
1395
1396 static void SQLITE_TCLAPI testvfs_obj_del(ClientData cd){
1397   Testvfs *p = (Testvfs *)cd;
1398   if( p->pScript ) Tcl_DecrRefCount(p->pScript);
1399   sqlite3_vfs_unregister(p->pVfs);
1400   memset(p->pVfs, 0, sizeof(sqlite3_vfs));
1401   ckfree((char *)p->pVfs);
1402   memset(p, 0, sizeof(Testvfs));
1403   ckfree((char *)p);
1404 }
1405
1406 /*
1407 ** Usage:  testvfs VFSNAME ?SWITCHES?
1408 **
1409 ** Switches are:
1410 **
1411 **   -noshm   BOOLEAN             (True to omit shm methods. Default false)
1412 **   -default BOOLEAN             (True to make the vfs default. Default false)
1413 **
1414 ** This command creates two things when it is invoked: an SQLite VFS, and
1415 ** a Tcl command. Both are named VFSNAME. The VFS is installed. It is not
1416 ** installed as the default VFS.
1417 **
1418 ** The VFS passes all file I/O calls through to the underlying VFS.
1419 **
1420 ** Whenever the xShmMap method of the VFS
1421 ** is invoked, the SCRIPT is executed as follows:
1422 **
1423 **   SCRIPT xShmMap    FILENAME ID
1424 **
1425 ** The value returned by the invocation of SCRIPT above is interpreted as
1426 ** an SQLite error code and returned to SQLite. Either a symbolic
1427 ** "SQLITE_OK" or numeric "0" value may be returned.
1428 **
1429 ** The contents of the shared-memory buffer associated with a given file
1430 ** may be read and set using the following command:
1431 **
1432 **   VFSNAME shm FILENAME ?NEWVALUE?
1433 **
1434 ** When the xShmLock method is invoked by SQLite, the following script is
1435 ** run:
1436 **
1437 **   SCRIPT xShmLock    FILENAME ID LOCK
1438 **
1439 ** where LOCK is of the form "OFFSET NBYTE lock/unlock shared/exclusive"
1440 */
1441 static int SQLITE_TCLAPI testvfs_cmd(
1442   ClientData cd,
1443   Tcl_Interp *interp,
1444   int objc,
1445   Tcl_Obj *CONST objv[]
1446 ){
1447   static sqlite3_vfs tvfs_vfs = {
1448     3,                            /* iVersion */
1449     0,                            /* szOsFile */
1450     0,                            /* mxPathname */
1451     0,                            /* pNext */
1452     0,                            /* zName */
1453     0,                            /* pAppData */
1454     tvfsOpen,                     /* xOpen */
1455     tvfsDelete,                   /* xDelete */
1456     tvfsAccess,                   /* xAccess */
1457     tvfsFullPathname,             /* xFullPathname */
1458 #ifndef SQLITE_OMIT_LOAD_EXTENSION
1459     tvfsDlOpen,                   /* xDlOpen */
1460     tvfsDlError,                  /* xDlError */
1461     tvfsDlSym,                    /* xDlSym */
1462     tvfsDlClose,                  /* xDlClose */
1463 #else
1464     0,                            /* xDlOpen */
1465     0,                            /* xDlError */
1466     0,                            /* xDlSym */
1467     0,                            /* xDlClose */
1468 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
1469     tvfsRandomness,               /* xRandomness */
1470     tvfsSleep,                    /* xSleep */
1471     tvfsCurrentTime,              /* xCurrentTime */
1472     0,                            /* xGetLastError */
1473     0,                            /* xCurrentTimeInt64 */
1474     0,                            /* xSetSystemCall */
1475     0,                            /* xGetSystemCall */
1476     0,                            /* xNextSystemCall */
1477   };
1478
1479   Testvfs *p;                     /* New object */
1480   sqlite3_vfs *pVfs;              /* New VFS */
1481   char *zVfs;
1482   int nByte;                      /* Bytes of space to allocate at p */
1483
1484   int i;
1485   int isNoshm = 0;                /* True if -noshm is passed */
1486   int isFullshm = 0;              /* True if -fullshm is passed */
1487   int isDefault = 0;              /* True if -default is passed */
1488   int szOsFile = 0;               /* Value passed to -szosfile */
1489   int mxPathname = -1;            /* Value passed to -mxpathname */
1490   int iVersion = 3;               /* Value passed to -iversion */
1491
1492   if( objc<2 || 0!=(objc%2) ) goto bad_args;
1493   for(i=2; i<objc; i += 2){
1494     int nSwitch;
1495     char *zSwitch;
1496     zSwitch = Tcl_GetStringFromObj(objv[i], &nSwitch);
1497
1498     if( nSwitch>2 && 0==strncmp("-noshm", zSwitch, nSwitch) ){
1499       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isNoshm) ){
1500         return TCL_ERROR;
1501       }
1502       if( isNoshm ) isFullshm = 0;
1503     }
1504     else if( nSwitch>2 && 0==strncmp("-default", zSwitch, nSwitch) ){
1505       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isDefault) ){
1506         return TCL_ERROR;
1507       }
1508     }
1509     else if( nSwitch>2 && 0==strncmp("-szosfile", zSwitch, nSwitch) ){
1510       if( Tcl_GetIntFromObj(interp, objv[i+1], &szOsFile) ){
1511         return TCL_ERROR;
1512       }
1513     }
1514     else if( nSwitch>2 && 0==strncmp("-mxpathname", zSwitch, nSwitch) ){
1515       if( Tcl_GetIntFromObj(interp, objv[i+1], &mxPathname) ){
1516         return TCL_ERROR;
1517       }
1518     }
1519     else if( nSwitch>2 && 0==strncmp("-iversion", zSwitch, nSwitch) ){
1520       if( Tcl_GetIntFromObj(interp, objv[i+1], &iVersion) ){
1521         return TCL_ERROR;
1522       }
1523     }
1524     else if( nSwitch>2 && 0==strncmp("-fullshm", zSwitch, nSwitch) ){
1525       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isFullshm) ){
1526         return TCL_ERROR;
1527       }
1528       if( isFullshm ) isNoshm = 0;
1529     }
1530     else{
1531       goto bad_args;
1532     }
1533   }
1534
1535   if( szOsFile<sizeof(TestvfsFile) ){
1536     szOsFile = sizeof(TestvfsFile);
1537   }
1538
1539   zVfs = Tcl_GetString(objv[1]);
1540   nByte = sizeof(Testvfs) + (int)strlen(zVfs)+1;
1541   p = (Testvfs *)ckalloc(nByte);
1542   memset(p, 0, nByte);
1543   p->iDevchar = -1;
1544   p->iSectorsize = -1;
1545
1546   /* Create the new object command before querying SQLite for a default VFS
1547   ** to use for 'real' IO operations. This is because creating the new VFS
1548   ** may delete an existing [testvfs] VFS of the same name. If such a VFS
1549   ** is currently the default, the new [testvfs] may end up calling the
1550   ** methods of a deleted object.
1551   */
1552   Tcl_CreateObjCommand(interp, zVfs, testvfs_obj_cmd, p, testvfs_obj_del);
1553   p->pParent = sqlite3_vfs_find(0);
1554   p->interp = interp;
1555
1556   p->zName = (char *)&p[1];
1557   memcpy(p->zName, zVfs, strlen(zVfs)+1);
1558
1559   pVfs = (sqlite3_vfs *)ckalloc(sizeof(sqlite3_vfs));
1560   memcpy(pVfs, &tvfs_vfs, sizeof(sqlite3_vfs));
1561   pVfs->pAppData = (void *)p;
1562   pVfs->iVersion = iVersion;
1563   pVfs->zName = p->zName;
1564   pVfs->mxPathname = p->pParent->mxPathname;
1565   if( mxPathname>=0 && mxPathname<pVfs->mxPathname ){
1566     pVfs->mxPathname = mxPathname;
1567   }
1568   pVfs->szOsFile = szOsFile;
1569   p->pVfs = pVfs;
1570   p->isNoshm = isNoshm;
1571   p->isFullshm = isFullshm;
1572   p->mask = TESTVFS_ALL_MASK;
1573
1574   sqlite3_vfs_register(pVfs, isDefault);
1575
1576   return TCL_OK;
1577
1578  bad_args:
1579   Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-fullshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
1580   return TCL_ERROR;
1581 }
1582
1583 extern int getDbPointer(Tcl_Interp *interp, const char *zA, sqlite3 **ppDb);
1584 extern const char *sqlite3ErrName(int);
1585
1586 /*
1587 ** tclcmd: vfs_shmlock DB DBNAME (shared|exclusive) (lock|unlock) OFFSET N
1588 */
1589 static int SQLITE_TCLAPI test_vfs_shmlock(
1590   void * clientData,
1591   Tcl_Interp *interp,
1592   int objc,
1593   Tcl_Obj *CONST objv[]
1594 ){
1595   const char *azArg1[] = {"shared", "exclusive", 0};
1596   const char *azArg2[] = {"lock", "unlock", 0};
1597   sqlite3 *db = 0;
1598   int rc = SQLITE_OK;
1599   const char *zDbname = 0;
1600   int iArg1 = 0;
1601   int iArg2 = 0;
1602   int iOffset = 0;
1603   int n = 0;
1604   sqlite3_file *pFd;
1605
1606   if( objc!=7 ){
1607     Tcl_WrongNumArgs(interp, 1, objv,
1608         "DB DBNAME (shared|exclusive) (lock|unlock) OFFSET N"
1609     );
1610     return TCL_ERROR;
1611   }
1612
1613   zDbname = Tcl_GetString(objv[2]);
1614   if( getDbPointer(interp, Tcl_GetString(objv[1]), &db)
1615    || Tcl_GetIndexFromObj(interp, objv[3], azArg1, "ARG", 0, &iArg1)
1616    || Tcl_GetIndexFromObj(interp, objv[4], azArg2, "ARG", 0, &iArg2)
1617    || Tcl_GetIntFromObj(interp, objv[5], &iOffset)
1618    || Tcl_GetIntFromObj(interp, objv[6], &n)
1619   ){
1620     return TCL_ERROR;
1621   }
1622
1623   sqlite3_file_control(db, zDbname, SQLITE_FCNTL_FILE_POINTER, (void*)&pFd);
1624   if( pFd==0 ){
1625     return TCL_ERROR;
1626   }
1627   rc = pFd->pMethods->xShmLock(pFd, iOffset, n,
1628       (iArg1==0 ? SQLITE_SHM_SHARED : SQLITE_SHM_EXCLUSIVE)
1629     | (iArg2==0 ? SQLITE_SHM_LOCK : SQLITE_SHM_UNLOCK)
1630   );
1631   Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3ErrName(rc), -1));
1632   return TCL_OK;
1633 }
1634
1635 static int SQLITE_TCLAPI test_vfs_set_readmark(
1636   void * clientData,
1637   Tcl_Interp *interp,
1638   int objc,
1639   Tcl_Obj *CONST objv[]
1640 ){
1641   sqlite3 *db = 0;
1642   int rc = SQLITE_OK;
1643   const char *zDbname = 0;
1644   int iSlot = 0;
1645   int iVal = -1;
1646   sqlite3_file *pFd;
1647   void volatile *pShm = 0;
1648   u32 *aShm;
1649   int iOff;
1650
1651   if( objc!=4 && objc!=5 ){
1652     Tcl_WrongNumArgs(interp, 1, objv, "DB DBNAME SLOT ?VALUE?");
1653     return TCL_ERROR;
1654   }
1655
1656   zDbname = Tcl_GetString(objv[2]);
1657   if( getDbPointer(interp, Tcl_GetString(objv[1]), &db)
1658    || Tcl_GetIntFromObj(interp, objv[3], &iSlot)
1659    || (objc==5 && Tcl_GetIntFromObj(interp, objv[4], &iVal))
1660   ){
1661     return TCL_ERROR;
1662   }
1663
1664   sqlite3_file_control(db, zDbname, SQLITE_FCNTL_FILE_POINTER, (void*)&pFd);
1665   if( pFd==0 ){
1666     return TCL_ERROR;
1667   }
1668   rc = pFd->pMethods->xShmMap(pFd, 0, 32*1024, 0, &pShm);
1669   if( rc!=SQLITE_OK ){
1670     Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3ErrName(rc), -1));
1671     return TCL_ERROR;
1672   }
1673   if( pShm==0 ){
1674     Tcl_AppendResult(interp, "*-shm is not yet mapped", 0);
1675     return TCL_ERROR;
1676   }
1677   aShm = (u32*)pShm;
1678   iOff = 12*2+1+iSlot;
1679
1680   if( objc==5 ){
1681     aShm[iOff] = iVal;
1682   }
1683   Tcl_SetObjResult(interp, Tcl_NewIntObj(aShm[iOff]));
1684
1685   return TCL_OK;
1686 }
1687
1688 int Sqlitetestvfs_Init(Tcl_Interp *interp){
1689   Tcl_CreateObjCommand(interp, "testvfs", testvfs_cmd, 0, 0);
1690   Tcl_CreateObjCommand(interp, "vfs_shmlock", test_vfs_shmlock, 0, 0);
1691   Tcl_CreateObjCommand(interp, "vfs_set_readmark", test_vfs_set_readmark, 0, 0);
1692   return TCL_OK;
1693 }
1694
1695 #endif