Import SQLite 3.7.6.3.

third_party/sqlite/src/src/test_vfs.c

+/*
+** 2010 May 05
+**
+** The author disclaims copyright to this source code.  In place of
+** a legal notice, here is a blessing:
+**
+**    May you do good and not evil.
+**    May you find forgiveness for yourself and forgive others.
+**    May you share freely, never taking more than you give.
+**
+******************************************************************************
+**
+*/
+#if SQLITE_TEST          /* This file is used for testing only */
+
+/*
+** This file contains the implementation of the Tcl [testvfs] command,
+** used to create SQLite VFS implementations with various properties and
+** instrumentation to support testing SQLite.
+**
+**   testvfs VFSNAME ?OPTIONS?
+**
+** Available options are:
+**
+**   -noshm      BOOLEAN        (True to omit shm methods. Default false)
+**   -default    BOOLEAN        (True to make the vfs default. Default false)
+**   -szosfile   INTEGER        (Value for sqlite3_vfs.szOsFile)
+**   -mxpathname INTEGER        (Value for sqlite3_vfs.mxPathname)
+**   -iversion   INTEGER        (Value for sqlite3_vfs.iVersion)
+*/
+
+#include "sqlite3.h"
+#include "sqliteInt.h"
+
+typedef struct Testvfs Testvfs;
+typedef struct TestvfsShm TestvfsShm;
+typedef struct TestvfsBuffer TestvfsBuffer;
+typedef struct TestvfsFile TestvfsFile;
+typedef struct TestvfsFd TestvfsFd;
+
+/*
+** An open file handle.
+*/
+struct TestvfsFile {
+  sqlite3_file base;              /* Base class.  Must be first */
+  TestvfsFd *pFd;                 /* File data */
+};
+#define tvfsGetFd(pFile) (((TestvfsFile *)pFile)->pFd)
+
+struct TestvfsFd {
+  sqlite3_vfs *pVfs;              /* The VFS */
+  const char *zFilename;          /* Filename as passed to xOpen() */
+  sqlite3_file *pReal;            /* The real, underlying file descriptor */
+  Tcl_Obj *pShmId;                /* Shared memory id for Tcl callbacks */
+
+  TestvfsBuffer *pShm;            /* Shared memory buffer */
+  u32 excllock;                   /* Mask of exclusive locks */
+  u32 sharedlock;                 /* Mask of shared locks */
+  TestvfsFd *pNext;               /* Next handle opened on the same file */
+};
+
+
+#define FAULT_INJECT_NONE       0
+#define FAULT_INJECT_TRANSIENT  1
+#define FAULT_INJECT_PERSISTENT 2
+
+typedef struct TestFaultInject TestFaultInject;
+struct TestFaultInject {
+  int iCnt;                       /* Remaining calls before fault injection */
+  int eFault;                     /* A FAULT_INJECT_* value */
+  int nFail;                      /* Number of faults injected */
+};
+
+/*
+** An instance of this structure is allocated for each VFS created. The
+** sqlite3_vfs.pAppData field of the VFS structure registered with SQLite
+** is set to point to it.
+*/
+struct Testvfs {
+  char *zName;                    /* Name of this VFS */
+  sqlite3_vfs *pParent;           /* The VFS to use for file IO */
+  sqlite3_vfs *pVfs;              /* The testvfs registered with SQLite */
+  Tcl_Interp *interp;             /* Interpreter to run script in */
+  Tcl_Obj *pScript;               /* Script to execute */
+  int nScript;                    /* Number of elements in array apScript */
+  Tcl_Obj **apScript;             /* Array version of pScript */
+  TestvfsBuffer *pBuffer;         /* List of shared buffers */
+  int isNoshm;
+
+  int mask;                       /* Mask controlling [script] and [ioerr] */
+
+  TestFaultInject ioerr_err;
+  TestFaultInject full_err;
+  TestFaultInject cantopen_err;
+
+#if 0
+  int iIoerrCnt;
+  int ioerr;
+  int nIoerrFail;
+  int iFullCnt;
+  int fullerr;
+  int nFullFail;
+#endif
+
+  int iDevchar;
+  int iSectorsize;
+};
+
+/*
+** The Testvfs.mask variable is set to a combination of the following.
+** If a bit is clear in Testvfs.mask, then calls made by SQLite to the 
+** corresponding VFS method is ignored for purposes of:
+**
+**   + Simulating IO errors, and
+**   + Invoking the Tcl callback script.
+*/
+#define TESTVFS_SHMOPEN_MASK    0x00000001
+#define TESTVFS_SHMLOCK_MASK    0x00000010
+#define TESTVFS_SHMMAP_MASK     0x00000020
+#define TESTVFS_SHMBARRIER_MASK 0x00000040
+#define TESTVFS_SHMCLOSE_MASK   0x00000080
+
+#define TESTVFS_OPEN_MASK       0x00000100
+#define TESTVFS_SYNC_MASK       0x00000200
+#define TESTVFS_DELETE_MASK     0x00000400
+#define TESTVFS_CLOSE_MASK      0x00000800
+#define TESTVFS_WRITE_MASK      0x00001000
+#define TESTVFS_TRUNCATE_MASK   0x00002000
+#define TESTVFS_ACCESS_MASK     0x00004000
+#define TESTVFS_ALL_MASK        0x00007FFF
+
+
+#define TESTVFS_MAX_PAGES 1024
+
+/*
+** A shared-memory buffer. There is one of these objects for each shared
+** memory region opened by clients. If two clients open the same file,
+** there are two TestvfsFile structures but only one TestvfsBuffer structure.
+*/
+struct TestvfsBuffer {
+  char *zFile;                    /* Associated file name */
+  int pgsz;                       /* Page size */
+  u8 *aPage[TESTVFS_MAX_PAGES];   /* Array of ckalloc'd pages */
+  TestvfsFd *pFile;               /* List of open handles */
+  TestvfsBuffer *pNext;           /* Next in linked list of all buffers */
+};
+
+
+#define PARENTVFS(x) (((Testvfs *)((x)->pAppData))->pParent)
+
+#define TESTVFS_MAX_ARGS 12
+
+
+/*
+** Method declarations for TestvfsFile.
+*/
+static int tvfsClose(sqlite3_file*);
+static int tvfsRead(sqlite3_file*, void*, int iAmt, sqlite3_int64 iOfst);
+static int tvfsWrite(sqlite3_file*,const void*,int iAmt, sqlite3_int64 iOfst);
+static int tvfsTruncate(sqlite3_file*, sqlite3_int64 size);
+static int tvfsSync(sqlite3_file*, int flags);
+static int tvfsFileSize(sqlite3_file*, sqlite3_int64 *pSize);
+static int tvfsLock(sqlite3_file*, int);
+static int tvfsUnlock(sqlite3_file*, int);
+static int tvfsCheckReservedLock(sqlite3_file*, int *);
+static int tvfsFileControl(sqlite3_file*, int op, void *pArg);
+static int tvfsSectorSize(sqlite3_file*);
+static int tvfsDeviceCharacteristics(sqlite3_file*);
+
+/*
+** Method declarations for tvfs_vfs.
+*/
+static int tvfsOpen(sqlite3_vfs*, const char *, sqlite3_file*, int , int *);
+static int tvfsDelete(sqlite3_vfs*, const char *zName, int syncDir);
+static int tvfsAccess(sqlite3_vfs*, const char *zName, int flags, int *);
+static int tvfsFullPathname(sqlite3_vfs*, const char *zName, int, char *zOut);
+#ifndef SQLITE_OMIT_LOAD_EXTENSION
+static void *tvfsDlOpen(sqlite3_vfs*, const char *zFilename);
+static void tvfsDlError(sqlite3_vfs*, int nByte, char *zErrMsg);
+static void (*tvfsDlSym(sqlite3_vfs*,void*, const char *zSymbol))(void);
+static void tvfsDlClose(sqlite3_vfs*, void*);
+#endif /* SQLITE_OMIT_LOAD_EXTENSION */
+static int tvfsRandomness(sqlite3_vfs*, int nByte, char *zOut);
+static int tvfsSleep(sqlite3_vfs*, int microseconds);
+static int tvfsCurrentTime(sqlite3_vfs*, double*);
+
+static int tvfsShmOpen(sqlite3_file*);
+static int tvfsShmLock(sqlite3_file*, int , int, int);
+static int tvfsShmMap(sqlite3_file*,int,int,int, void volatile **);
+static void tvfsShmBarrier(sqlite3_file*);
+static int tvfsShmUnmap(sqlite3_file*, int);
+
+static sqlite3_io_methods tvfs_io_methods = {
+  2,                              /* iVersion */
+  tvfsClose,                      /* xClose */
+  tvfsRead,                       /* xRead */
+  tvfsWrite,                      /* xWrite */
+  tvfsTruncate,                   /* xTruncate */
+  tvfsSync,                       /* xSync */
+  tvfsFileSize,                   /* xFileSize */
+  tvfsLock,                       /* xLock */
+  tvfsUnlock,                     /* xUnlock */
+  tvfsCheckReservedLock,          /* xCheckReservedLock */
+  tvfsFileControl,                /* xFileControl */
+  tvfsSectorSize,                 /* xSectorSize */
+  tvfsDeviceCharacteristics,      /* xDeviceCharacteristics */
+  tvfsShmMap,                     /* xShmMap */
+  tvfsShmLock,                    /* xShmLock */
+  tvfsShmBarrier,                 /* xShmBarrier */
+  tvfsShmUnmap                    /* xShmUnmap */
+};
+
+static int tvfsResultCode(Testvfs *p, int *pRc){
+  struct errcode {
+    int eCode;
+    const char *zCode;
+  } aCode[] = {
+    { SQLITE_OK,     "SQLITE_OK"     },
+    { SQLITE_ERROR,  "SQLITE_ERROR"  },
+    { SQLITE_IOERR,  "SQLITE_IOERR"  },
+    { SQLITE_LOCKED, "SQLITE_LOCKED" },
+    { SQLITE_BUSY,   "SQLITE_BUSY"   },
+  };
+
+  const char *z;
+  int i;
+
+  z = Tcl_GetStringResult(p->interp);
+  for(i=0; i<ArraySize(aCode); i++){
+    if( 0==strcmp(z, aCode[i].zCode) ){
+      *pRc = aCode[i].eCode;
+      return 1;
+    }
+  }
+
+  return 0;
+}
+
+static int tvfsInjectFault(TestFaultInject *p){
+  int ret = 0;
+  if( p->eFault ){
+    p->iCnt--;
+    if( p->iCnt==0 || (p->iCnt<0 && p->eFault==FAULT_INJECT_PERSISTENT ) ){
+      ret = 1;
+      p->nFail++;
+    }
+  }
+  return ret;
+}
+
+
+static int tvfsInjectIoerr(Testvfs *p){
+  return tvfsInjectFault(&p->ioerr_err);
+}
+
+static int tvfsInjectFullerr(Testvfs *p){
+  return tvfsInjectFault(&p->full_err);
+}
+static int tvfsInjectCantopenerr(Testvfs *p){
+  return tvfsInjectFault(&p->cantopen_err);
+}
+
+
+static void tvfsExecTcl(
+  Testvfs *p, 
+  const char *zMethod,
+  Tcl_Obj *arg1,
+  Tcl_Obj *arg2,
+  Tcl_Obj *arg3
+){
+  int rc;                         /* Return code from Tcl_EvalObj() */
+  int nArg;                       /* Elements in eval'd list */
+  int nScript;
+  Tcl_Obj ** ap;
+
+  assert( p->pScript );
+
+  if( !p->apScript ){
+    int nByte;
+    int i;
+    if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
+      Tcl_BackgroundError(p->interp);
+      Tcl_ResetResult(p->interp);
+      return;
+    }
+    p->nScript = nScript;
+    nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
+    p->apScript = (Tcl_Obj **)ckalloc(nByte);
+    memset(p->apScript, 0, nByte);
+    for(i=0; i<nScript; i++){
+      p->apScript[i] = ap[i];
+    }
+  }
+
+  p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
+  p->apScript[p->nScript+1] = arg1;
+  p->apScript[p->nScript+2] = arg2;
+  p->apScript[p->nScript+3] = arg3;
+
+  for(nArg=p->nScript; p->apScript[nArg]; nArg++){
+    Tcl_IncrRefCount(p->apScript[nArg]);
+  }
+
+  rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
+  if( rc!=TCL_OK ){
+    Tcl_BackgroundError(p->interp);
+    Tcl_ResetResult(p->interp);
+  }
+
+  for(nArg=p->nScript; p->apScript[nArg]; nArg++){
+    Tcl_DecrRefCount(p->apScript[nArg]);
+    p->apScript[nArg] = 0;
+  }
+}
+
+
+/*
+** Close an tvfs-file.
+*/
+static int tvfsClose(sqlite3_file *pFile){
+  int rc;
+  TestvfsFile *pTestfile = (TestvfsFile *)pFile;
+  TestvfsFd *pFd = pTestfile->pFd;
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+
+  if( p->pScript && p->mask&TESTVFS_CLOSE_MASK ){
+    tvfsExecTcl(p, "xClose", 
+        Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
+    );
+  }
+
+  if( pFd->pShmId ){
+    Tcl_DecrRefCount(pFd->pShmId);
+    pFd->pShmId = 0;
+  }
+  if( pFile->pMethods ){
+    ckfree((char *)pFile->pMethods);
+  }
+  rc = sqlite3OsClose(pFd->pReal);
+  ckfree((char *)pFd);
+  pTestfile->pFd = 0;
+  return rc;
+}
+
+/*
+** Read data from an tvfs-file.
+*/
+static int tvfsRead(
+  sqlite3_file *pFile, 
+  void *zBuf, 
+  int iAmt, 
+  sqlite_int64 iOfst
+){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsRead(p->pReal, zBuf, iAmt, iOfst);
+}
+
+/*
+** Write data to an tvfs-file.
+*/
+static int tvfsWrite(
+  sqlite3_file *pFile, 
+  const void *zBuf, 
+  int iAmt, 
+  sqlite_int64 iOfst
+){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+
+  if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){
+    tvfsExecTcl(p, "xWrite", 
+        Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
+    );
+    tvfsResultCode(p, &rc);
+  }
+
+  if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){
+    rc = SQLITE_FULL;
+  }
+  if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
+    rc = SQLITE_IOERR;
+  }
+  
+  if( rc==SQLITE_OK ){
+    rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst);
+  }
+  return rc;
+}
+
+/*
+** Truncate an tvfs-file.
+*/
+static int tvfsTruncate(sqlite3_file *pFile, sqlite_int64 size){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+
+  if( p->pScript && p->mask&TESTVFS_TRUNCATE_MASK ){
+    tvfsExecTcl(p, "xTruncate", 
+        Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
+    );
+    tvfsResultCode(p, &rc);
+  }
+  
+  if( rc==SQLITE_OK ){
+    rc = sqlite3OsTruncate(pFd->pReal, size);
+  }
+  return rc;
+}
+
+/*
+** Sync an tvfs-file.
+*/
+static int tvfsSync(sqlite3_file *pFile, int flags){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+
+  if( p->pScript && p->mask&TESTVFS_SYNC_MASK ){
+    char *zFlags;
+
+    switch( flags ){
+      case SQLITE_SYNC_NORMAL:
+        zFlags = "normal";
+        break;
+      case SQLITE_SYNC_FULL:
+        zFlags = "full";
+        break;
+      case SQLITE_SYNC_NORMAL|SQLITE_SYNC_DATAONLY:
+        zFlags = "normal|dataonly";
+        break;
+      case SQLITE_SYNC_FULL|SQLITE_SYNC_DATAONLY:
+        zFlags = "full|dataonly";
+        break;
+      default:
+        assert(0);
+    }
+
+    tvfsExecTcl(p, "xSync", 
+        Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
+        Tcl_NewStringObj(zFlags, -1)
+    );
+    tvfsResultCode(p, &rc);
+  }
+
+  if( rc==SQLITE_OK && tvfsInjectFullerr(p) ) rc = SQLITE_FULL;
+
+  if( rc==SQLITE_OK ){
+    rc = sqlite3OsSync(pFd->pReal, flags);
+  }
+
+  return rc;
+}
+
+/*
+** Return the current file-size of an tvfs-file.
+*/
+static int tvfsFileSize(sqlite3_file *pFile, sqlite_int64 *pSize){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsFileSize(p->pReal, pSize);
+}
+
+/*
+** Lock an tvfs-file.
+*/
+static int tvfsLock(sqlite3_file *pFile, int eLock){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsLock(p->pReal, eLock);
+}
+
+/*
+** Unlock an tvfs-file.
+*/
+static int tvfsUnlock(sqlite3_file *pFile, int eLock){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsUnlock(p->pReal, eLock);
+}
+
+/*
+** Check if another file-handle holds a RESERVED lock on an tvfs-file.
+*/
+static int tvfsCheckReservedLock(sqlite3_file *pFile, int *pResOut){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsCheckReservedLock(p->pReal, pResOut);
+}
+
+/*
+** File control method. For custom operations on an tvfs-file.
+*/
+static int tvfsFileControl(sqlite3_file *pFile, int op, void *pArg){
+  TestvfsFd *p = tvfsGetFd(pFile);
+  return sqlite3OsFileControl(p->pReal, op, pArg);
+}
+
+/*
+** Return the sector-size in bytes for an tvfs-file.
+*/
+static int tvfsSectorSize(sqlite3_file *pFile){
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+  if( p->iSectorsize>=0 ){
+    return p->iSectorsize;
+  }
+  return sqlite3OsSectorSize(pFd->pReal);
+}
+
+/*
+** Return the device characteristic flags supported by an tvfs-file.
+*/
+static int tvfsDeviceCharacteristics(sqlite3_file *pFile){
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
+  if( p->iDevchar>=0 ){
+    return p->iDevchar;
+  }
+  return sqlite3OsDeviceCharacteristics(pFd->pReal);
+}
+
+/*
+** Open an tvfs file handle.
+*/
+static int tvfsOpen(
+  sqlite3_vfs *pVfs,
+  const char *zName,
+  sqlite3_file *pFile,
+  int flags,
+  int *pOutFlags
+){
+  int rc;
+  TestvfsFile *pTestfile = (TestvfsFile *)pFile;
+  TestvfsFd *pFd;
+  Tcl_Obj *pId = 0;
+  Testvfs *p = (Testvfs *)pVfs->pAppData;
+
+  pFd = (TestvfsFd *)ckalloc(sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
+  memset(pFd, 0, sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
+  pFd->pShm = 0;
+  pFd->pShmId = 0;
+  pFd->zFilename = zName;
+  pFd->pVfs = pVfs;
+  pFd->pReal = (sqlite3_file *)&pFd[1];
+  memset(pTestfile, 0, sizeof(TestvfsFile));
+  pTestfile->pFd = pFd;
+
+  /* Evaluate the Tcl script: 
+  **
+  **   SCRIPT xOpen FILENAME
+  **
+  ** If the script returns an SQLite error code other than SQLITE_OK, an
+  ** error is returned to the caller. If it returns SQLITE_OK, the new
+  ** connection is named "anon". Otherwise, the value returned by the
+  ** script is used as the connection name.
+  */
+  Tcl_ResetResult(p->interp);
+  if( p->pScript && p->mask&TESTVFS_OPEN_MASK ){
+    tvfsExecTcl(p, "xOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0);
+    if( tvfsResultCode(p, &rc) ){
+      if( rc!=SQLITE_OK ) return rc;
+    }else{
+      pId = Tcl_GetObjResult(p->interp);
+    }
+  }
+
+  if( (p->mask&TESTVFS_OPEN_MASK) &&  tvfsInjectIoerr(p) ) return SQLITE_IOERR;
+  if( tvfsInjectCantopenerr(p) ) return SQLITE_CANTOPEN;
+  if( tvfsInjectFullerr(p) ) return SQLITE_FULL;
+
+  if( !pId ){
+    pId = Tcl_NewStringObj("anon", -1);
+  }
+  Tcl_IncrRefCount(pId);
+  pFd->pShmId = pId;
+  Tcl_ResetResult(p->interp);
+
+  rc = sqlite3OsOpen(PARENTVFS(pVfs), zName, pFd->pReal, flags, pOutFlags);
+  if( pFd->pReal->pMethods ){
+    sqlite3_io_methods *pMethods;
+    int nByte;
+
+    if( pVfs->iVersion>1 ){
+      nByte = sizeof(sqlite3_io_methods);
+    }else{
+      nByte = offsetof(sqlite3_io_methods, xShmMap);
+    }
+
+    pMethods = (sqlite3_io_methods *)ckalloc(nByte);
+    memcpy(pMethods, &tvfs_io_methods, nByte);
+    pMethods->iVersion = pVfs->iVersion;
+    if( pVfs->iVersion>1 && ((Testvfs *)pVfs->pAppData)->isNoshm ){
+      pMethods->xShmUnmap = 0;
+      pMethods->xShmLock = 0;
+      pMethods->xShmBarrier = 0;
+      pMethods->xShmMap = 0;
+    }
+    pFile->pMethods = pMethods;
+  }
+
+  return rc;
+}
+
+/*
+** Delete the file located at zPath. If the dirSync argument is true,
+** ensure the file-system modifications are synced to disk before
+** returning.
+*/
+static int tvfsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){
+  int rc = SQLITE_OK;
+  Testvfs *p = (Testvfs *)pVfs->pAppData;
+
+  if( p->pScript && p->mask&TESTVFS_DELETE_MASK ){
+    tvfsExecTcl(p, "xDelete", 
+        Tcl_NewStringObj(zPath, -1), Tcl_NewIntObj(dirSync), 0
+    );
+    tvfsResultCode(p, &rc);
+  }
+  if( rc==SQLITE_OK ){
+    rc = sqlite3OsDelete(PARENTVFS(pVfs), zPath, dirSync);
+  }
+  return rc;
+}
+
+/*
+** Test for access permissions. Return true if the requested permission
+** is available, or false otherwise.
+*/
+static int tvfsAccess(
+  sqlite3_vfs *pVfs, 
+  const char *zPath, 
+  int flags, 
+  int *pResOut
+){
+  Testvfs *p = (Testvfs *)pVfs->pAppData;
+  if( p->pScript && p->mask&TESTVFS_ACCESS_MASK ){
+    int rc;
+    char *zArg = 0;
+    if( flags==SQLITE_ACCESS_EXISTS ) zArg = "SQLITE_ACCESS_EXISTS";
+    if( flags==SQLITE_ACCESS_READWRITE ) zArg = "SQLITE_ACCESS_READWRITE";
+    if( flags==SQLITE_ACCESS_READ ) zArg = "SQLITE_ACCESS_READ";
+    tvfsExecTcl(p, "xAccess", 
+        Tcl_NewStringObj(zPath, -1), Tcl_NewStringObj(zArg, -1), 0
+    );
+    if( tvfsResultCode(p, &rc) ){
+      if( rc!=SQLITE_OK ) return rc;
+    }else{
+      Tcl_Interp *interp = p->interp;
+      if( TCL_OK==Tcl_GetBooleanFromObj(0, Tcl_GetObjResult(interp), pResOut) ){
+        return SQLITE_OK;
+      }
+    }
+  }
+  return sqlite3OsAccess(PARENTVFS(pVfs), zPath, flags, pResOut);
+}
+
+/*
+** Populate buffer zOut with the full canonical pathname corresponding
+** to the pathname in zPath. zOut is guaranteed to point to a buffer
+** of at least (DEVSYM_MAX_PATHNAME+1) bytes.
+*/
+static int tvfsFullPathname(
+  sqlite3_vfs *pVfs, 
+  const char *zPath, 
+  int nOut, 
+  char *zOut
+){
+  return sqlite3OsFullPathname(PARENTVFS(pVfs), zPath, nOut, zOut);
+}
+
+#ifndef SQLITE_OMIT_LOAD_EXTENSION
+/*
+** Open the dynamic library located at zPath and return a handle.
+*/
+static void *tvfsDlOpen(sqlite3_vfs *pVfs, const char *zPath){
+  return sqlite3OsDlOpen(PARENTVFS(pVfs), zPath);
+}
+
+/*
+** Populate the buffer zErrMsg (size nByte bytes) with a human readable
+** utf-8 string describing the most recent error encountered associated 
+** with dynamic libraries.
+*/
+static void tvfsDlError(sqlite3_vfs *pVfs, int nByte, char *zErrMsg){
+  sqlite3OsDlError(PARENTVFS(pVfs), nByte, zErrMsg);
+}
+
+/*
+** Return a pointer to the symbol zSymbol in the dynamic library pHandle.
+*/
+static void (*tvfsDlSym(sqlite3_vfs *pVfs, void *p, const char *zSym))(void){
+  return sqlite3OsDlSym(PARENTVFS(pVfs), p, zSym);
+}
+
+/*
+** Close the dynamic library handle pHandle.
+*/
+static void tvfsDlClose(sqlite3_vfs *pVfs, void *pHandle){
+  sqlite3OsDlClose(PARENTVFS(pVfs), pHandle);
+}
+#endif /* SQLITE_OMIT_LOAD_EXTENSION */
+
+/*
+** Populate the buffer pointed to by zBufOut with nByte bytes of 
+** random data.
+*/
+static int tvfsRandomness(sqlite3_vfs *pVfs, int nByte, char *zBufOut){
+  return sqlite3OsRandomness(PARENTVFS(pVfs), nByte, zBufOut);
+}
+
+/*
+** Sleep for nMicro microseconds. Return the number of microseconds 
+** actually slept.
+*/
+static int tvfsSleep(sqlite3_vfs *pVfs, int nMicro){
+  return sqlite3OsSleep(PARENTVFS(pVfs), nMicro);
+}
+
+/*
+** Return the current time as a Julian Day number in *pTimeOut.
+*/
+static int tvfsCurrentTime(sqlite3_vfs *pVfs, double *pTimeOut){
+  return PARENTVFS(pVfs)->xCurrentTime(PARENTVFS(pVfs), pTimeOut);
+}
+
+static int tvfsShmOpen(sqlite3_file *pFile){
+  Testvfs *p;
+  int rc = SQLITE_OK;             /* Return code */
+  TestvfsBuffer *pBuffer;         /* Buffer to open connection to */
+  TestvfsFd *pFd;                 /* The testvfs file structure */
+
+  pFd = tvfsGetFd(pFile);
+  p = (Testvfs *)pFd->pVfs->pAppData;
+  assert( pFd->pShmId && pFd->pShm==0 && pFd->pNext==0 );
+
+  /* Evaluate the Tcl script: 
+  **
+  **   SCRIPT xShmOpen FILENAME
+  */
+  Tcl_ResetResult(p->interp);
+  if( p->pScript && p->mask&TESTVFS_SHMOPEN_MASK ){
+    tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0);
+    if( tvfsResultCode(p, &rc) ){
+      if( rc!=SQLITE_OK ) return rc;
+    }
+  }
+
+  assert( rc==SQLITE_OK );
+  if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
+    return SQLITE_IOERR;
+  }
+
+  /* Search for a TestvfsBuffer. Create a new one if required. */
+  for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
+    if( 0==strcmp(pFd->zFilename, pBuffer->zFile) ) break;
+  }
+  if( !pBuffer ){
+    int nByte = sizeof(TestvfsBuffer) + strlen(pFd->zFilename) + 1;
+    pBuffer = (TestvfsBuffer *)ckalloc(nByte);
+    memset(pBuffer, 0, nByte);
+    pBuffer->zFile = (char *)&pBuffer[1];
+    strcpy(pBuffer->zFile, pFd->zFilename);
+    pBuffer->pNext = p->pBuffer;
+    p->pBuffer = pBuffer;
+  }
+
+  /* Connect the TestvfsBuffer to the new TestvfsShm handle and return. */
+  pFd->pNext = pBuffer->pFile;
+  pBuffer->pFile = pFd;
+  pFd->pShm = pBuffer;
+  return SQLITE_OK;
+}
+
+static void tvfsAllocPage(TestvfsBuffer *p, int iPage, int pgsz){
+  assert( iPage<TESTVFS_MAX_PAGES );
+  if( p->aPage[iPage]==0 ){
+    p->aPage[iPage] = (u8 *)ckalloc(pgsz);
+    memset(p->aPage[iPage], 0, pgsz);
+    p->pgsz = pgsz;
+  }
+}
+
+static int tvfsShmMap(
+  sqlite3_file *pFile,            /* Handle open on database file */
+  int iPage,                      /* Page to retrieve */
+  int pgsz,                       /* Size of pages */
+  int isWrite,                    /* True to extend file if necessary */
+  void volatile **pp              /* OUT: Mapped memory */
+){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
+
+  if( 0==pFd->pShm ){
+    rc = tvfsShmOpen(pFile);
+    if( rc!=SQLITE_OK ){
+      return rc;
+    }
+  }
+
+  if( p->pScript && p->mask&TESTVFS_SHMMAP_MASK ){
+    Tcl_Obj *pArg = Tcl_NewObj();
+    Tcl_IncrRefCount(pArg);
+    Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(iPage));
+    Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(pgsz));
+    Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(isWrite));
+    tvfsExecTcl(p, "xShmMap", 
+        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, pArg
+    );
+    tvfsResultCode(p, &rc);
+    Tcl_DecrRefCount(pArg);
+  }
+  if( rc==SQLITE_OK && p->mask&TESTVFS_SHMMAP_MASK && tvfsInjectIoerr(p) ){
+    rc = SQLITE_IOERR;
+  }
+
+  if( rc==SQLITE_OK && isWrite && !pFd->pShm->aPage[iPage] ){
+    tvfsAllocPage(pFd->pShm, iPage, pgsz);
+  }
+  *pp = (void volatile *)pFd->pShm->aPage[iPage];
+
+  return rc;
+}
+
+
+static int tvfsShmLock(
+  sqlite3_file *pFile,
+  int ofst,
+  int n,
+  int flags
+){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
+  int nLock;
+  char zLock[80];
+
+  if( p->pScript && p->mask&TESTVFS_SHMLOCK_MASK ){
+    sqlite3_snprintf(sizeof(zLock), zLock, "%d %d", ofst, n);
+    nLock = strlen(zLock);
+    if( flags & SQLITE_SHM_LOCK ){
+      strcpy(&zLock[nLock], " lock");
+    }else{
+      strcpy(&zLock[nLock], " unlock");
+    }
+    nLock += strlen(&zLock[nLock]);
+    if( flags & SQLITE_SHM_SHARED ){
+      strcpy(&zLock[nLock], " shared");
+    }else{
+      strcpy(&zLock[nLock], " exclusive");
+    }
+    tvfsExecTcl(p, "xShmLock", 
+        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId,
+        Tcl_NewStringObj(zLock, -1)
+    );
+    tvfsResultCode(p, &rc);
+  }
+
+  if( rc==SQLITE_OK && p->mask&TESTVFS_SHMLOCK_MASK && tvfsInjectIoerr(p) ){
+    rc = SQLITE_IOERR;
+  }
+
+  if( rc==SQLITE_OK ){
+    int isLock = (flags & SQLITE_SHM_LOCK);
+    int isExcl = (flags & SQLITE_SHM_EXCLUSIVE);
+    u32 mask = (((1<<n)-1) << ofst);
+    if( isLock ){
+      TestvfsFd *p2;
+      for(p2=pFd->pShm->pFile; p2; p2=p2->pNext){
+        if( p2==pFd ) continue;
+        if( (p2->excllock&mask) || (isExcl && p2->sharedlock&mask) ){
+          rc = SQLITE_BUSY;
+          break;
+        }
+      }
+      if( rc==SQLITE_OK ){
+        if( isExcl )  pFd->excllock |= mask;
+        if( !isExcl ) pFd->sharedlock |= mask;
+      }
+    }else{
+      if( isExcl )  pFd->excllock &= (~mask);
+      if( !isExcl ) pFd->sharedlock &= (~mask);
+    }
+  }
+
+  return rc;
+}
+
+static void tvfsShmBarrier(sqlite3_file *pFile){
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
+
+  if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
+    tvfsExecTcl(p, "xShmBarrier", 
+        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
+    );
+  }
+}
+
+static int tvfsShmUnmap(
+  sqlite3_file *pFile,
+  int deleteFlag
+){
+  int rc = SQLITE_OK;
+  TestvfsFd *pFd = tvfsGetFd(pFile);
+  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
+  TestvfsBuffer *pBuffer = pFd->pShm;
+  TestvfsFd **ppFd;
+
+  if( !pBuffer ) return SQLITE_OK;
+  assert( pFd->pShmId && pFd->pShm );
+
+  if( p->pScript && p->mask&TESTVFS_SHMCLOSE_MASK ){
+    tvfsExecTcl(p, "xShmUnmap", 
+        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
+    );
+    tvfsResultCode(p, &rc);
+  }
+
+  for(ppFd=&pBuffer->pFile; *ppFd!=pFd; ppFd=&((*ppFd)->pNext));
+  assert( (*ppFd)==pFd );
+  *ppFd = pFd->pNext;
+  pFd->pNext = 0;
+
+  if( pBuffer->pFile==0 ){
+    int i;
+    TestvfsBuffer **pp;
+    for(pp=&p->pBuffer; *pp!=pBuffer; pp=&((*pp)->pNext));
+    *pp = (*pp)->pNext;
+    for(i=0; pBuffer->aPage[i]; i++){
+      ckfree((char *)pBuffer->aPage[i]);
+    }
+    ckfree((char *)pBuffer);
+  }
+  pFd->pShm = 0;
+
+  return rc;
+}
+
+static int testvfs_obj_cmd(
+  ClientData cd,
+  Tcl_Interp *interp,
+  int objc,
+  Tcl_Obj *CONST objv[]
+){
+  Testvfs *p = (Testvfs *)cd;
+
+  enum DB_enum { 
+    CMD_SHM, CMD_DELETE, CMD_FILTER, CMD_IOERR, CMD_SCRIPT, 
+    CMD_DEVCHAR, CMD_SECTORSIZE, CMD_FULLERR, CMD_CANTOPENERR
+  };
+  struct TestvfsSubcmd {
+    char *zName;
+    enum DB_enum eCmd;
+  } aSubcmd[] = {
+    { "shm",         CMD_SHM         },
+    { "delete",      CMD_DELETE      },
+    { "filter",      CMD_FILTER      },
+    { "ioerr",       CMD_IOERR       },
+    { "fullerr",     CMD_FULLERR     },
+    { "cantopenerr", CMD_CANTOPENERR },
+    { "script",      CMD_SCRIPT      },
+    { "devchar",     CMD_DEVCHAR     },
+    { "sectorsize",  CMD_SECTORSIZE  },
+    { 0, 0 }
+  };
+  int i;
+  
+  if( objc<2 ){
+    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
+    return TCL_ERROR;
+  }
+  if( Tcl_GetIndexFromObjStruct(
+        interp, objv[1], aSubcmd, sizeof(aSubcmd[0]), "subcommand", 0, &i) 
+  ){
+    return TCL_ERROR;
+  }
+  Tcl_ResetResult(interp);
+
+  switch( aSubcmd[i].eCmd ){
+    case CMD_SHM: {
+      Tcl_Obj *pObj;
+      int i;
+      TestvfsBuffer *pBuffer;
+      char *zName;
+      if( objc!=3 && objc!=4 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "FILE ?VALUE?");
+        return TCL_ERROR;
+      }
+      zName = ckalloc(p->pParent->mxPathname);
+      p->pParent->xFullPathname(
+          p->pParent, Tcl_GetString(objv[2]), 
+          p->pParent->mxPathname, zName
+      );
+      for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
+        if( 0==strcmp(pBuffer->zFile, zName) ) break;
+      }
+      ckfree(zName);
+      if( !pBuffer ){
+        Tcl_AppendResult(interp, "no such file: ", Tcl_GetString(objv[2]), 0);
+        return TCL_ERROR;
+      }
+      if( objc==4 ){
+        int n;
+        u8 *a = Tcl_GetByteArrayFromObj(objv[3], &n);
+        int pgsz = pBuffer->pgsz;
+        if( pgsz==0 ) pgsz = 65536;
+        for(i=0; i*pgsz<n; i++){
+          int nByte = pgsz;
+          tvfsAllocPage(pBuffer, i, pgsz);
+          if( n-i*pgsz<pgsz ){
+            nByte = n;
+          }
+          memcpy(pBuffer->aPage[i], &a[i*pgsz], nByte);
+        }
+      }
+
+      pObj = Tcl_NewObj();
+      for(i=0; pBuffer->aPage[i]; i++){
+        int pgsz = pBuffer->pgsz;
+        if( pgsz==0 ) pgsz = 65536;
+        Tcl_AppendObjToObj(pObj, Tcl_NewByteArrayObj(pBuffer->aPage[i], pgsz));
+      }
+      Tcl_SetObjResult(interp, pObj);
+      break;
+    }
+
+    case CMD_FILTER: {
+      static struct VfsMethod {
+        char *zName;
+        int mask;
+      } vfsmethod [] = {
+        { "xShmOpen",    TESTVFS_SHMOPEN_MASK },
+        { "xShmLock",    TESTVFS_SHMLOCK_MASK },
+        { "xShmBarrier", TESTVFS_SHMBARRIER_MASK },
+        { "xShmUnmap",   TESTVFS_SHMCLOSE_MASK },
+        { "xShmMap",     TESTVFS_SHMMAP_MASK },
+        { "xSync",       TESTVFS_SYNC_MASK },
+        { "xDelete",     TESTVFS_DELETE_MASK },
+        { "xWrite",      TESTVFS_WRITE_MASK },
+        { "xTruncate",   TESTVFS_TRUNCATE_MASK },
+        { "xOpen",       TESTVFS_OPEN_MASK },
+        { "xClose",      TESTVFS_CLOSE_MASK },
+        { "xAccess",     TESTVFS_ACCESS_MASK },
+      };
+      Tcl_Obj **apElem = 0;
+      int nElem = 0;
+      int i;
+      int mask = 0;
+      if( objc!=3 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "LIST");
+        return TCL_ERROR;
+      }
+      if( Tcl_ListObjGetElements(interp, objv[2], &nElem, &apElem) ){
+        return TCL_ERROR;
+      }
+      Tcl_ResetResult(interp);
+      for(i=0; i<nElem; i++){
+        int iMethod;
+        char *zElem = Tcl_GetString(apElem[i]);
+        for(iMethod=0; iMethod<ArraySize(vfsmethod); iMethod++){
+          if( strcmp(zElem, vfsmethod[iMethod].zName)==0 ){
+            mask |= vfsmethod[iMethod].mask;
+            break;
+          }
+        }
+        if( iMethod==ArraySize(vfsmethod) ){
+          Tcl_AppendResult(interp, "unknown method: ", zElem, 0);
+          return TCL_ERROR;
+        }
+      }
+      p->mask = mask;
+      break;
+    }
+
+    case CMD_SCRIPT: {
+      if( objc==3 ){
+        int nByte;
+        if( p->pScript ){
+          Tcl_DecrRefCount(p->pScript);
+          ckfree((char *)p->apScript);
+          p->apScript = 0;
+          p->nScript = 0;
+          p->pScript = 0;
+        }
+        Tcl_GetStringFromObj(objv[2], &nByte);
+        if( nByte>0 ){
+          p->pScript = Tcl_DuplicateObj(objv[2]);
+          Tcl_IncrRefCount(p->pScript);
+        }
+      }else if( objc!=2 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
+        return TCL_ERROR;
+      }
+
+      Tcl_ResetResult(interp);
+      if( p->pScript ) Tcl_SetObjResult(interp, p->pScript);
+
+      break;
+    }
+
+    /*
+    ** TESTVFS ioerr ?IFAIL PERSIST?
+    **
+    **   Where IFAIL is an integer and PERSIST is boolean.
+    */
+    case CMD_CANTOPENERR:
+    case CMD_IOERR:
+    case CMD_FULLERR: {
+      TestFaultInject *pTest;
+      int iRet;
+
+      switch( aSubcmd[i].eCmd ){
+        case CMD_IOERR: pTest = &p->ioerr_err; break;
+        case CMD_FULLERR: pTest = &p->full_err; break;
+        case CMD_CANTOPENERR: pTest = &p->cantopen_err; break;
+        default: assert(0);
+      }
+      iRet = pTest->nFail;
+      pTest->nFail = 0;
+      pTest->eFault = 0;
+      pTest->iCnt = 0;
+
+      if( objc==4 ){
+        int iCnt, iPersist;
+        if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &iCnt)
+         || TCL_OK!=Tcl_GetBooleanFromObj(interp, objv[3], &iPersist)
+        ){
+          return TCL_ERROR;
+        }
+        pTest->eFault = iPersist?FAULT_INJECT_PERSISTENT:FAULT_INJECT_TRANSIENT;
+        pTest->iCnt = iCnt;
+      }else if( objc!=2 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "?CNT PERSIST?");
+        return TCL_ERROR;
+      }
+      Tcl_SetObjResult(interp, Tcl_NewIntObj(iRet));
+      break;
+    }
+
+    case CMD_DELETE: {
+      Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
+      break;
+    }
+
+    case CMD_DEVCHAR: {
+      struct DeviceFlag {
+        char *zName;
+        int iValue;
+      } aFlag[] = {
+        { "default",               -1 },
+        { "atomic",                SQLITE_IOCAP_ATOMIC      },
+        { "atomic512",             SQLITE_IOCAP_ATOMIC512   },
+        { "atomic1k",              SQLITE_IOCAP_ATOMIC1K    },
+        { "atomic2k",              SQLITE_IOCAP_ATOMIC2K    },
+        { "atomic4k",              SQLITE_IOCAP_ATOMIC4K    },
+        { "atomic8k",              SQLITE_IOCAP_ATOMIC8K    },
+        { "atomic16k",             SQLITE_IOCAP_ATOMIC16K   },
+        { "atomic32k",             SQLITE_IOCAP_ATOMIC32K   },
+        { "atomic64k",             SQLITE_IOCAP_ATOMIC64K   },
+        { "sequential",            SQLITE_IOCAP_SEQUENTIAL  },
+        { "safe_append",           SQLITE_IOCAP_SAFE_APPEND },
+        { "undeletable_when_open", SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN },
+        { 0, 0 }
+      };
+      Tcl_Obj *pRet;
+      int iFlag;
+
+      if( objc>3 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "?ATTR-LIST?");
+        return TCL_ERROR;
+      }
+      if( objc==3 ){
+        int j;
+        int iNew = 0;
+        Tcl_Obj **flags = 0;
+        int nFlags = 0;
+
+        if( Tcl_ListObjGetElements(interp, objv[2], &nFlags, &flags) ){
+          return TCL_ERROR;
+        }
+
+        for(j=0; j<nFlags; j++){
+          int idx = 0;
+          if( Tcl_GetIndexFromObjStruct(interp, flags[j], aFlag, 
+                sizeof(aFlag[0]), "flag", 0, &idx) 
+          ){
+            return TCL_ERROR;
+          }
+          if( aFlag[idx].iValue<0 && nFlags>1 ){
+            Tcl_AppendResult(interp, "bad flags: ", Tcl_GetString(objv[2]), 0);
+            return TCL_ERROR;
+          }
+          iNew |= aFlag[idx].iValue;
+        }
+
+        p->iDevchar = iNew;
+      }
+
+      pRet = Tcl_NewObj();
+      for(iFlag=0; iFlag<sizeof(aFlag)/sizeof(aFlag[0]); iFlag++){
+        if( p->iDevchar & aFlag[iFlag].iValue ){
+          Tcl_ListObjAppendElement(
+              interp, pRet, Tcl_NewStringObj(aFlag[iFlag].zName, -1)
+          );
+        }
+      }
+      Tcl_SetObjResult(interp, pRet);
+
+      break;
+    }
+
+    case CMD_SECTORSIZE: {
+      if( objc>3 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "?VALUE?");
+        return TCL_ERROR;
+      }
+      if( objc==3 ){
+        int iNew = 0;
+        if( Tcl_GetIntFromObj(interp, objv[2], &iNew) ){
+          return TCL_ERROR;
+        }
+        p->iSectorsize = iNew;
+      }
+      Tcl_SetObjResult(interp, Tcl_NewIntObj(p->iSectorsize));
+      break;
+    }
+  }
+
+  return TCL_OK;
+}
+
+static void testvfs_obj_del(ClientData cd){
+  Testvfs *p = (Testvfs *)cd;
+  if( p->pScript ) Tcl_DecrRefCount(p->pScript);
+  sqlite3_vfs_unregister(p->pVfs);
+  ckfree((char *)p->apScript);
+  ckfree((char *)p->pVfs);
+  ckfree((char *)p);
+}
+
+/*
+** Usage:  testvfs VFSNAME ?SWITCHES?
+**
+** Switches are:
+**
+**   -noshm   BOOLEAN             (True to omit shm methods. Default false)
+**   -default BOOLEAN             (True to make the vfs default. Default false)
+**
+** This command creates two things when it is invoked: an SQLite VFS, and
+** a Tcl command. Both are named VFSNAME. The VFS is installed. It is not
+** installed as the default VFS.
+**
+** The VFS passes all file I/O calls through to the underlying VFS.
+**
+** Whenever the xShmMap method of the VFS
+** is invoked, the SCRIPT is executed as follows:
+**
+**   SCRIPT xShmMap    FILENAME ID
+**
+** The value returned by the invocation of SCRIPT above is interpreted as
+** an SQLite error code and returned to SQLite. Either a symbolic 
+** "SQLITE_OK" or numeric "0" value may be returned.
+**
+** The contents of the shared-memory buffer associated with a given file
+** may be read and set using the following command:
+**
+**   VFSNAME shm FILENAME ?NEWVALUE?
+**
+** When the xShmLock method is invoked by SQLite, the following script is
+** run:
+**
+**   SCRIPT xShmLock    FILENAME ID LOCK
+**
+** where LOCK is of the form "OFFSET NBYTE lock/unlock shared/exclusive"
+*/
+static int testvfs_cmd(
+  ClientData cd,
+  Tcl_Interp *interp,
+  int objc,
+  Tcl_Obj *CONST objv[]
+){
+  static sqlite3_vfs tvfs_vfs = {
+    2,                            /* iVersion */
+    0,                            /* szOsFile */
+    0,                            /* mxPathname */
+    0,                            /* pNext */
+    0,                            /* zName */
+    0,                            /* pAppData */
+    tvfsOpen,                     /* xOpen */
+    tvfsDelete,                   /* xDelete */
+    tvfsAccess,                   /* xAccess */
+    tvfsFullPathname,             /* xFullPathname */
+#ifndef SQLITE_OMIT_LOAD_EXTENSION
+    tvfsDlOpen,                   /* xDlOpen */
+    tvfsDlError,                  /* xDlError */
+    tvfsDlSym,                    /* xDlSym */
+    tvfsDlClose,                  /* xDlClose */
+#else
+    0,                            /* xDlOpen */
+    0,                            /* xDlError */
+    0,                            /* xDlSym */
+    0,                            /* xDlClose */
+#endif /* SQLITE_OMIT_LOAD_EXTENSION */
+    tvfsRandomness,               /* xRandomness */
+    tvfsSleep,                    /* xSleep */
+    tvfsCurrentTime,              /* xCurrentTime */
+    0,                            /* xGetLastError */
+    0,                            /* xCurrentTimeInt64 */
+  };
+
+  Testvfs *p;                     /* New object */
+  sqlite3_vfs *pVfs;              /* New VFS */
+  char *zVfs;
+  int nByte;                      /* Bytes of space to allocate at p */
+
+  int i;
+  int isNoshm = 0;                /* True if -noshm is passed */
+  int isDefault = 0;              /* True if -default is passed */
+  int szOsFile = 0;               /* Value passed to -szosfile */
+  int mxPathname = -1;            /* Value passed to -mxpathname */
+  int iVersion = 2;               /* Value passed to -iversion */
+
+  if( objc<2 || 0!=(objc%2) ) goto bad_args;
+  for(i=2; i<objc; i += 2){
+    int nSwitch;
+    char *zSwitch;
+    zSwitch = Tcl_GetStringFromObj(objv[i], &nSwitch); 
+
+    if( nSwitch>2 && 0==strncmp("-noshm", zSwitch, nSwitch) ){
+      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isNoshm) ){
+        return TCL_ERROR;
+      }
+    }
+    else if( nSwitch>2 && 0==strncmp("-default", zSwitch, nSwitch) ){
+      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isDefault) ){
+        return TCL_ERROR;
+      }
+    }
+    else if( nSwitch>2 && 0==strncmp("-szosfile", zSwitch, nSwitch) ){
+      if( Tcl_GetIntFromObj(interp, objv[i+1], &szOsFile) ){
+        return TCL_ERROR;
+      }
+    }
+    else if( nSwitch>2 && 0==strncmp("-mxpathname", zSwitch, nSwitch) ){
+      if( Tcl_GetIntFromObj(interp, objv[i+1], &mxPathname) ){
+        return TCL_ERROR;
+      }
+    }
+    else if( nSwitch>2 && 0==strncmp("-iversion", zSwitch, nSwitch) ){
+      if( Tcl_GetIntFromObj(interp, objv[i+1], &iVersion) ){
+        return TCL_ERROR;
+      }
+    }
+    else{
+      goto bad_args;
+    }
+  }
+
+  if( szOsFile<sizeof(TestvfsFile) ){
+    szOsFile = sizeof(TestvfsFile);
+  }
+
+  zVfs = Tcl_GetString(objv[1]);
+  nByte = sizeof(Testvfs) + strlen(zVfs)+1;
+  p = (Testvfs *)ckalloc(nByte);
+  memset(p, 0, nByte);
+  p->iDevchar = -1;
+  p->iSectorsize = -1;
+
+  /* Create the new object command before querying SQLite for a default VFS
+  ** to use for 'real' IO operations. This is because creating the new VFS
+  ** may delete an existing [testvfs] VFS of the same name. If such a VFS
+  ** is currently the default, the new [testvfs] may end up calling the 
+  ** methods of a deleted object.
+  */
+  Tcl_CreateObjCommand(interp, zVfs, testvfs_obj_cmd, p, testvfs_obj_del);
+  p->pParent = sqlite3_vfs_find(0);
+  p->interp = interp;
+
+  p->zName = (char *)&p[1];
+  memcpy(p->zName, zVfs, strlen(zVfs)+1);
+
+  pVfs = (sqlite3_vfs *)ckalloc(sizeof(sqlite3_vfs));
+  memcpy(pVfs, &tvfs_vfs, sizeof(sqlite3_vfs));
+  pVfs->pAppData = (void *)p;
+  pVfs->iVersion = iVersion;
+  pVfs->zName = p->zName;
+  pVfs->mxPathname = p->pParent->mxPathname;
+  if( mxPathname>=0 && mxPathname<pVfs->mxPathname ){
+    pVfs->mxPathname = mxPathname;
+  }
+  pVfs->szOsFile = szOsFile;
+  p->pVfs = pVfs;
+  p->isNoshm = isNoshm;
+  p->mask = TESTVFS_ALL_MASK;
+
+  sqlite3_vfs_register(pVfs, isDefault);
+
+  return TCL_OK;
+
+ bad_args:
+  Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
+  return TCL_ERROR;
+}
+
+int Sqlitetestvfs_Init(Tcl_Interp *interp){
+  Tcl_CreateObjCommand(interp, "testvfs", testvfs_cmd, 0, 0);
+  return TCL_OK;
+}
+
+#endif