text: /*
  ** 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.
  **
  ******************************************************************************
  **
  ** 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)
  */
  #if SQLITE_TEST          /* This file is used for testing only */
  
  #include "sqlite3.h"
  #include "sqliteInt.h"
  #if defined(INCLUDE_SQLITE_TCL_H)
  #  include "sqlite_tcl.h"
  #else
  #  include "tcl.h"
  #endif
  
  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 */
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
    int nScript;                    /* Number of elements in array apScript */
    Tcl_Obj **apScript;             /* Array version of pScript */
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    TestvfsBuffer *pBuffer;         /* List of shared buffers */
    int isNoshm;
    int isFullshm;
  
    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_FULLPATHNAME_MASK 0x00008000
  #define TESTVFS_READ_MASK         0x00010000
  #define TESTVFS_UNLOCK_MASK       0x00020000
  #define TESTVFS_LOCK_MASK         0x00040000
  #define TESTVFS_CKLOCK_MASK       0x00080000
  #define TESTVFS_FCNTL_MASK        0x00100000
  
  #define TESTVFS_ALL_MASK          0x001FFFFF
  
  
  #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 int tvfsFetch(sqlite3_file*, sqlite3_int64, int, void**);
  static int tvfsUnfetch(sqlite3_file*, sqlite3_int64, void*);
  
  static sqlite3_io_methods tvfs_io_methods = {
    3,                              /* 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 */
    tvfsFetch,
    tvfsUnfetch
  };
  
  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,
    Tcl_Obj *arg4
  ){
    int rc;                         /* Return code from Tcl_EvalObj() */
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
    int nArg;                       /* Elements in eval'd list */
    int nScript;
    Tcl_Obj ** ap;
  #else /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    Tcl_Obj *pEval;
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
  
    assert( p->pScript );
  
    assert( zMethod );
    assert( p );
    assert( arg2==0 || arg1!=0 );
    assert( arg3==0 || arg2!=0 );
  
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
    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;
    /* TODO: p->apScript[p->nScript+4] = arg4; */
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    pEval = Tcl_DuplicateObj(p->pScript);
    Tcl_IncrRefCount(p->pScript);
    Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zMethod, -1));
    if( arg1 ) Tcl_ListObjAppendElement(p->interp, pEval, arg1);
    if( arg2 ) Tcl_ListObjAppendElement(p->interp, pEval, arg2);
    if( arg3 ) Tcl_ListObjAppendElement(p->interp, pEval, arg3);
    if( arg4 ) Tcl_ListObjAppendElement(p->interp, pEval, arg4);
  
    for(nArg=p->nScript; p->apScript[nArg]; nArg++){
      Tcl_IncrRefCount(p->apScript[nArg]);
    }
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
    rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
  #else /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    if( rc!=TCL_OK ){
      Tcl_BackgroundError(p->interp);
      Tcl_ResetResult(p->interp);
    }
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
    for(nArg=p->nScript; p->apScript[nArg]; nArg++){
      Tcl_DecrRefCount(p->apScript[nArg]);
      p->apScript[nArg] = 0;
    }
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
  }
  
  
  /*
  ** Close an tvfs-file.
  */
  static int tvfsClose(sqlite3_file *pFile){
    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, 0
      );
    }
  
    if( pFd->pShmId ){
      Tcl_DecrRefCount(pFd->pShmId);
      pFd->pShmId = 0;
    }
    if( pFile->pMethods ){
      ckfree((char *)pFile->pMethods);
    }
    sqlite3OsClose(pFd->pReal);
    ckfree((char *)pFd);
    pTestfile->pFd = 0;
    return SQLITE_OK;
  }
  
  /*
  ** Read data from an tvfs-file.
  */
  static int tvfsRead(
    sqlite3_file *pFile, 
    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_READ_MASK ){
      tvfsExecTcl(p, "xRead", 
          Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
      );
      tvfsResultCode(p, &rc);
    }
    if( rc==SQLITE_OK && p->mask&TESTVFS_READ_MASK && tvfsInjectIoerr(p) ){
      rc = SQLITE_IOERR;
    }
    if( rc==SQLITE_OK ){
      rc = sqlite3OsRead(pFd->pReal, zBuf, iAmt, iOfst);
    }
    return rc;
  }
  
  /*
  ** 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, 
          Tcl_NewWideIntObj(iOfst), Tcl_NewIntObj(iAmt)
      );
      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, 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 = 0;
  
      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), 0
      );
      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 *pFd = tvfsGetFd(pFile);
    Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
    if( p->pScript && p->mask&TESTVFS_LOCK_MASK ){
      char zLock[30];
      sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
      tvfsExecTcl(p, "xLock", Tcl_NewStringObj(pFd->zFilename, -1), 
                     Tcl_NewStringObj(zLock, -1), 0, 0);
    }
    return sqlite3OsLock(pFd->pReal, eLock);
  }
  
  /*
  ** Unlock an tvfs-file.
  */
  static int tvfsUnlock(sqlite3_file *pFile, int eLock){
    TestvfsFd *pFd = tvfsGetFd(pFile);
    Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
    if( p->pScript && p->mask&TESTVFS_UNLOCK_MASK ){
      char zLock[30];
      sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
      tvfsExecTcl(p, "xUnlock", Tcl_NewStringObj(pFd->zFilename, -1), 
                     Tcl_NewStringObj(zLock, -1), 0, 0);
    }
    if( p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
      return SQLITE_IOERR_UNLOCK;
    }
    return sqlite3OsUnlock(pFd->pReal, eLock);
  }
  
  /*
  ** Check if another file-handle holds a RESERVED lock on an tvfs-file.
  */
  static int tvfsCheckReservedLock(sqlite3_file *pFile, int *pResOut){
    TestvfsFd *pFd = tvfsGetFd(pFile);
    Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
    if( p->pScript && p->mask&TESTVFS_CKLOCK_MASK ){
      tvfsExecTcl(p, "xCheckReservedLock", Tcl_NewStringObj(pFd->zFilename, -1),
                     0, 0, 0);
    }
    return sqlite3OsCheckReservedLock(pFd->pReal, pResOut);
  }
  
  /*
  ** File control method. For custom operations on an tvfs-file.
  */
  static int tvfsFileControl(sqlite3_file *pFile, int op, void *pArg){
    TestvfsFd *pFd = tvfsGetFd(pFile);
    Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
    if( op==SQLITE_FCNTL_PRAGMA ){
      char **argv = (char**)pArg;
      if( sqlite3_stricmp(argv[1],"error")==0 ){
        int rc = SQLITE_ERROR;
        if( argv[2] ){
          const char *z = argv[2];
          int x = atoi(z);
          if( x ){
            rc = x;
            while( sqlite3Isdigit(z[0]) ){ z++; }
            while( sqlite3Isspace(z[0]) ){ z++; }
          }
          if( z[0] ) argv[0] = sqlite3_mprintf("%s", z);
        }
        return rc;
      }
      if( sqlite3_stricmp(argv[1], "filename")==0 ){
        argv[0] = sqlite3_mprintf("%s", pFd->zFilename);
        return SQLITE_OK;
      }
    }
    if( p->pScript && (p->mask&TESTVFS_FCNTL_MASK) ){
      struct Fcntl {
        int iFnctl;
        const char *zFnctl;
      } aF[] = {
        { SQLITE_FCNTL_BEGIN_ATOMIC_WRITE, "BEGIN_ATOMIC_WRITE" },
        { SQLITE_FCNTL_COMMIT_ATOMIC_WRITE, "COMMIT_ATOMIC_WRITE" },
      };
      int i;
      for(i=0; i<sizeof(aF)/sizeof(aF[0]); i++){
        if( op==aF[i].iFnctl ) break;
      }
      if( i<sizeof(aF)/sizeof(aF[0]) ){
        int rc = 0;
        tvfsExecTcl(p, "xFileControl", 
            Tcl_NewStringObj(pFd->zFilename, -1), 
            Tcl_NewStringObj(aF[i].zFnctl, -1),
            0, 0
        );
        tvfsResultCode(p, &rc);
        if( rc ) return rc;
      }
    }
    return sqlite3OsFileControl(pFd->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 KEY-VALUE-ARGS
    **
    ** 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 ){
      Tcl_Obj *pArg = Tcl_NewObj();
      Tcl_IncrRefCount(pArg);
      if( flags&SQLITE_OPEN_MAIN_DB ){
        const char *z = &zName[strlen(zName)+1];
        while( *z ){
          Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
          z += strlen(z) + 1;
          Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
          z += strlen(z) + 1;
        }
      }
      tvfsExecTcl(p, "xOpen", Tcl_NewStringObj(pFd->zFilename, -1), pArg, 0, 0);
      Tcl_DecrRefCount(pArg);
      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 = pFd->pReal->pMethods->iVersion;
      if( pMethods->iVersion>pVfs->iVersion ){
        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, 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, 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
  ){
    Testvfs *p = (Testvfs *)pVfs->pAppData;
    if( p->pScript && p->mask&TESTVFS_FULLPATHNAME_MASK ){
      int rc;
      tvfsExecTcl(p, "xFullPathname", Tcl_NewStringObj(zPath, -1), 0, 0, 0);
      if( tvfsResultCode(p, &rc) ){
        if( rc!=SQLITE_OK ) return rc;
      }
    }
    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( 0==p->isFullshm );
    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, 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 szName = (int)strlen(pFd->zFilename);
      int nByte = sizeof(TestvfsBuffer) + szName + 1;
      pBuffer = (TestvfsBuffer *)ckalloc(nByte);
      memset(pBuffer, 0, nByte);
      pBuffer->zFile = (char *)&pBuffer[1];
      memcpy(pBuffer->zFile, pFd->zFilename, szName+1);
      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( p->isFullshm ){
      return sqlite3OsShmMap(pFd->pReal, iPage, pgsz, isWrite, pp);
    }
  
    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, 0
      );
      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->isFullshm ){
      return sqlite3OsShmLock(pFd->pReal, ofst, n, flags);
    }
  
    if( p->pScript && p->mask&TESTVFS_SHMLOCK_MASK ){
      sqlite3_snprintf(sizeof(zLock), zLock, "%d %d", ofst, n);
      nLock = (int)strlen(zLock);
      if( flags & SQLITE_SHM_LOCK ){
        strcpy(&zLock[nLock], " lock");
      }else{
        strcpy(&zLock[nLock], " unlock");
      }
      nLock += (int)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), 0
      );
      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 ){
      const char *z = pFd->pShm ? pFd->pShm->zFile : "";
      tvfsExecTcl(p, "xShmBarrier", Tcl_NewStringObj(z, -1), pFd->pShmId, 0, 0);
    }
  
    if( p->isFullshm ){
      sqlite3OsShmBarrier(pFd->pReal);
      return;
    }
  }
  
  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( p->isFullshm ){
      return sqlite3OsShmUnmap(pFd->pReal, deleteFlag);
    }
  
    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, 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 tvfsFetch(
      sqlite3_file *pFile, 
      sqlite3_int64 iOfst, 
      int iAmt, 
      void **pp
  ){
    TestvfsFd *pFd = tvfsGetFd(pFile);
    return sqlite3OsFetch(pFd->pReal, iOfst, iAmt, pp);
  }
  
  static int tvfsUnfetch(sqlite3_file *pFile, sqlite3_int64 iOfst, void *p){
    TestvfsFd *pFd = tvfsGetFd(pFile);
    return sqlite3OsUnfetch(pFd->pReal, iOfst, p);
  }
  
  static int SQLITE_TCLAPI 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 rc;
        TestvfsBuffer *pBuffer;
        char *zName;
        if( objc!=3 && objc!=4 ){
          Tcl_WrongNumArgs(interp, 2, objv, "FILE ?VALUE?");
          return TCL_ERROR;
        }
        zName = ckalloc(p->pParent->mxPathname);
        rc = p->pParent->xFullPathname(
            p->pParent, Tcl_GetString(objv[2]), 
            p->pParent->mxPathname, zName
        );
        if( rc!=SQLITE_OK ){
          Tcl_AppendResult(interp, "failed to get full path: ",
                           Tcl_GetString(objv[2]), 0);
          ckfree(zName);
          return TCL_ERROR;
        }
        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;
      }
  
      /*  TESTVFS filter METHOD-LIST
      **
      **     Activate special processing for those methods contained in the list
      */
      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 },
          { "xRead",              TESTVFS_READ_MASK },
          { "xTruncate",          TESTVFS_TRUNCATE_MASK },
          { "xOpen",              TESTVFS_OPEN_MASK },
          { "xClose",             TESTVFS_CLOSE_MASK },
          { "xAccess",            TESTVFS_ACCESS_MASK },
          { "xFullPathname",      TESTVFS_FULLPATHNAME_MASK },
          { "xUnlock",            TESTVFS_UNLOCK_MASK },
          { "xLock",              TESTVFS_LOCK_MASK },
          { "xCheckReservedLock", TESTVFS_CKLOCK_MASK },
          { "xFileControl",       TESTVFS_FCNTL_MASK },
        };
        Tcl_Obj **apElem = 0;
        int nElem = 0;
        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;
      }
  
      /*
      **  TESTVFS script ?SCRIPT?
      **
      **  Query or set the script to be run when filtered VFS events
      **  occur.
      */
      case CMD_SCRIPT: {
        if( objc==3 ){
          int nByte;
          if( p->pScript ){
            Tcl_DecrRefCount(p->pScript);
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
            ckfree((char *)p->apScript);
            p->apScript = 0;
            p->nScript = 0;
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
            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 = 0;
        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 },
          { "powersafe_overwrite",   SQLITE_IOCAP_POWERSAFE_OVERWRITE   },
          { "immutable",             SQLITE_IOCAP_IMMUTABLE             },
          { 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| 0x10000000;
        }
  
        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 SQLITE_TCLAPI testvfs_obj_del(ClientData cd){
    Testvfs *p = (Testvfs *)cd;
    if( p->pScript ) Tcl_DecrRefCount(p->pScript);
    sqlite3_vfs_unregister(p->pVfs);
  #if defined(SQLITE_BUILDING_FOR_COMDB2)
  #else /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    ckfree((char *)p->apScript);
  #endif /* defined(SQLITE_BUILDING_FOR_COMDB2) */
    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 SQLITE_TCLAPI testvfs_cmd(
    ClientData cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[]
  ){
    static sqlite3_vfs tvfs_vfs = {
      3,                            /* 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 */
      0,                            /* xSetSystemCall */
      0,                            /* xGetSystemCall */
      0,                            /* xNextSystemCall */
    };
  
    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 isFullshm = 0;              /* True if -fullshm 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 = 3;               /* 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;
        }
        if( isNoshm ) isFullshm = 0;
      }
      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 if( nSwitch>2 && 0==strncmp("-fullshm", zSwitch, nSwitch) ){
        if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isFullshm) ){
          return TCL_ERROR;
        }
        if( isFullshm ) isNoshm = 0;
      }
      else{
        goto bad_args;
      }
    }
  
    if( szOsFile<sizeof(TestvfsFile) ){
      szOsFile = sizeof(TestvfsFile);
    }
  
    zVfs = Tcl_GetString(objv[1]);
    nByte = sizeof(Testvfs) + (int)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->isFullshm = isFullshm;
    p->mask = TESTVFS_ALL_MASK;
  
    sqlite3_vfs_register(pVfs, isDefault);
  
    return TCL_OK;
  
   bad_args:
    Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-fullshm 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
  