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