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;
  int iIoerrCnt;
  int ioerr;
  int nIoerrFail;
};

/*
** 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_SHMSIZE_MASK    0x00000002
#define TESTVFS_SHMGET_MASK     0x00000004
#define TESTVFS_SHMRELEASE_MASK 0x00000008
#define TESTVFS_SHMLOCK_MASK    0x00000010
#define TESTVFS_SHMBARRIER_MASK 0x00000020
#define TESTVFS_SHMCLOSE_MASK   0x00000040

#define TESTVFS_ALL_MASK        0x0000007F

/*
** A shared-memory buffer.
*/
struct TestvfsBuffer {
  char *zFile;                    /* Associated file name */
  int n;                          /* Size of allocated buffer in bytes */
  u8 *a;                          /* Buffer allocated using ckalloc() */
  int nRef;                       /* Number of references to this object */
  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);

  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++){

      *pRc = aCode[i].eCode;
      return 1;
    }
  }

  return 0;
}

static int tvfsInjectIoerr(Testvfs *p){
  int ret = 0;
  if( p->ioerr ){
    p->iIoerrCnt--;
    if( p->iIoerrCnt==0 || (p->iIoerrCnt<0 && p->ioerr==2) ){
      ret = 1;
      p->nIoerrFail++;
    }
  }
  return ret;
}

static int tvfsShmOpen(
  sqlite3_file *pFileDes
){
  Testvfs *p;
  int rc = SQLITE_OK;             /* Return code */
  Tcl_Obj *pId = 0;               /* Id for this connection */

  **
  ** 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_SHMOPEN_MASK ){
    tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0);

    if( tvfsResultCode(p, &rc) ){
      if( rc!=SQLITE_OK ) return rc;

    }else{
      pId = Tcl_GetObjResult(p->interp);
    }
  }
  if( !pId ){
    pId = Tcl_NewStringObj("anon", -1);
  }
  Tcl_IncrRefCount(pId);

  assert( rc==SQLITE_OK );
  if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
    Tcl_DecrRefCount(pId);
    return SQLITE_IOERR;
  }

  pFd->pShmId = pId;

  /* 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 reqSize,
  int *pNewSize
){
  int rc = SQLITE_OK;
  TestvfsFile *pFd = (TestvfsFile *)pFile;
  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);

  if( p->pScript && p->mask&TESTVFS_SHMSIZE_MASK ){
    tvfsExecTcl(p, "xShmSize", 
        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
    );
    tvfsResultCode(p, &rc);
  }
  if( rc==SQLITE_OK && p->mask&TESTVFS_SHMSIZE_MASK && tvfsInjectIoerr(p) ){
    rc = SQLITE_IOERR;
  }
  if( rc==SQLITE_OK ){
    tvfsGrowBuffer(pFd, reqSize, pNewSize);
  }
  return rc;
}

static int tvfsShmGet(
  sqlite3_file *pFile, 
  int reqMapSize, 
  int *pMapSize, 
  volatile void **pp
){
  int rc = SQLITE_OK;
  TestvfsFile *pFd = (TestvfsFile *)pFile;
  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);

  if( p->pScript && p->mask&TESTVFS_SHMGET_MASK ){
    tvfsExecTcl(p, "xShmGet", 
        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
    );
    tvfsResultCode(p, &rc);
  }
  if( rc==SQLITE_OK && p->mask&TESTVFS_SHMGET_MASK && tvfsInjectIoerr(p) ){
    rc = SQLITE_IOERR;
  }
  if( rc==SQLITE_OK ){
    tvfsGrowBuffer(pFd, reqMapSize, pMapSize);
    *pp = pFd->pShm->a;
  }
  return rc;
}

static int tvfsShmRelease(sqlite3_file *pFile){
  int rc = SQLITE_OK;
  TestvfsFile *pFd = (TestvfsFile *)pFile;
  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);

  if( p->pScript && p->mask&TESTVFS_SHMRELEASE_MASK ){
    tvfsExecTcl(p, "xShmRelease", 
        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
    );
    tvfsResultCode(p, &rc);
  }

  return rc;

){
  int rc = SQLITE_OK;
  TestvfsFile *pFd = (TestvfsFile *)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");
    }

  return rc;
}

static void tvfsShmBarrier(sqlite3_file *pFile){
  TestvfsFile *pFd = (TestvfsFile *)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 tvfsShmClose(
  sqlite3_file *pFile,
  int deleteFlag
){
  int rc = SQLITE_OK;
  TestvfsFile *pFd = (TestvfsFile *)pFile;
  Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
  TestvfsBuffer *pBuffer = pFd->pShm;

  assert( pFd->pShmId && pFd->pShm );
#if 0
  assert( (deleteFlag!=0)==(pBuffer->nRef==1) );
#endif

  if( p->pScript && p->mask&TESTVFS_SHMCLOSE_MASK ){
    tvfsExecTcl(p, "xShmClose", 
        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
    );
    tvfsResultCode(p, &rc);
  }

  pBuffer->nRef--;

  ClientData cd,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Testvfs *p = (Testvfs *)cd;

  static const char *CMD_strs[] = { 
    "shm",   "delete",   "filter",   "ioerr",   "script", 0 
  };
  enum DB_enum { 
    CMD_SHM, CMD_DELETE, CMD_FILTER, CMD_IOERR, CMD_SCRIPT
  };

  int i;
  
  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], CMD_strs, "subcommand", 0, &i) ){

          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;
        }
        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_IOERR: {
      int iRet = p->nIoerrFail;

      p->nIoerrFail = 0;
      p->ioerr = 0;
      p->iIoerrCnt = 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;
        }
        p->ioerr = (iCnt>0) + iPersist;
        p->iIoerrCnt = iCnt;
      }else if( objc!=2 ){
        Tcl_AppendResult(interp, "Bad args", 0);
        return TCL_ERROR;
      }
      Tcl_SetObjResult(interp, Tcl_NewIntObj(iRet));
      break;
    }

    case CMD_DELETE: {
      Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
      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.
**

    0,
    0,
  };

  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 */

  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{
      goto bad_args;
    }
  }

  zVfs = Tcl_GetString(objv[1]);
  nByte = sizeof(Testvfs) + strlen(zVfs)+1;
  p = (Testvfs *)ckalloc(nByte);
  memset(p, 0, nByte);

  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->zName = p->zName;
  pVfs->mxPathname = p->pParent->mxPathname;
  pVfs->szOsFile += p->pParent->szOsFile;
  p->pVfs = pVfs;
  p->isNoshm = isNoshm;
  p->mask = TESTVFS_ALL_MASK;

  Tcl_CreateObjCommand(interp, zVfs, testvfs_obj_cmd, p, testvfs_obj_del);
  sqlite3_vfs_register(pVfs, isDefault);

  return TCL_OK;

 bad_args:
  Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-default BOOL?");
  return TCL_ERROR;
}

int Sqlitetestvfs_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "testvfs", testvfs_cmd, 0, 0);
  return TCL_OK;
}

#endif

ifcapable builtin_test {
  set MEMDEBUG 1
} else {
  set MEMDEBUG 0
  return 0
}

# Transient and persistent OOM errors:
#
set FAULTSIM(oom-transient) [list          \
  -injectstart   {oom_injectstart 0}       \
  -injectstop    oom_injectstop            \
  -injecterrlist {{1 {out of memory}}}     \
]
set FAULTSIM(oom-persistent) [list         \
  -injectstart {oom_injectstart 1000000}   \
  -injectstop oom_injectstop               \
  -injecterrlist {{1 {out of memory}}}     \
]
  
# Transient and persistent IO errors:
#
set FAULTSIM(ioerr-transient) [list        \
  -injectstart   {ioerr_injectstart 0}     \
  -injectstop    ioerr_injectstop          \
  -injecterrlist {{1 {disk I/O error}}}    \
]
set FAULTSIM(ioerr-persistent) [list       \
  -injectstart   {ioerr_injectstart 1}     \
  -injectstop    ioerr_injectstop          \
  -injecterrlist {{1 {disk I/O error}}}    \
]

# Transient and persistent SHM errors:
#
set FAULTSIM(shmerr-transient) [list       \
  -injectinstall   shmerr_injectinstall    \
  -injectstart     {shmerr_injectstart 0}  \
  -injectstop      shmerr_injectstop       \
  -injecterrlist   {{1 {disk I/O error}}}  \
  -injectuninstall shmerr_injectuninstall  \
]
set FAULTSIM(shmerr-persistent) [list      \
  -injectinstall   shmerr_injectinstall    \
  -injectstart     {shmerr_injectstart 1}  \
  -injectstop      shmerr_injectstop       \
  -injecterrlist   {{1 {disk I/O error}}}  \
  -injectuninstall shmerr_injectuninstall  \
]



#--------------------------------------------------------------------------
# Usage do_faultsim_test NAME ?OPTIONS...? 
#
#     -faults           List of fault types to simulate.
#
#     -prep             Script to execute before -body.
#
#     -body             Script to execute (with fault injection).
#
#     -test             Script to execute after -body.
#
proc do_faultsim_test {name args} {
  global FAULTSIM


  
  set DEFAULT(-faults)        [array names FAULTSIM]
  set DEFAULT(-prep)          ""
  set DEFAULT(-body)          ""
  set DEFAULT(-test)          ""

  array set O [array get DEFAULT]
  array set O $args
  foreach o [array names O] {
    if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
  }




  set faultlist [list]






  foreach f $O(-faults) {
    set flist [array names FAULTSIM $f]




    if {[llength $flist]==0} { error "unknown fault: $f" }



    set faultlist [concat $faultlist $flist]

  }



  set testspec [list -prep $O(-prep) -body $O(-body) -test $O(-test)]
  foreach f [lsort -unique $faultlist] {
    eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
  }
}

#-------------------------------------------------------------------------
# Procedures to save and restore the current file-system state:
#
#   faultsim_save_and_close

    }
  }
  sqlite3 db test.db
  sqlite3_extended_result_codes db 1
  sqlite3_db_config_lookaside db 0 0 0
}

proc faultsim_integrity_check {{db db}} {
  set ic [$db eval { PRAGMA integrity_check }]
  if {$ic != "ok"} { error "Integrity check: $ic" }
}

proc faultsim_delete_and_reopen {{file test.db}} {
  catch { db close }
  file delete -force test.db test.db-wal test.db-journal
  sqlite3 db test.db
}


# The following procs are used as [do_one_faultsim_test] callbacks when 
# injecting OOM faults into test cases.
#
proc oom_injectstart {nRepeat iFail} {
  sqlite3_memdebug_fail $iFail -repeat $nRepeat
}
proc oom_injectstop {} {
  sqlite3_memdebug_fail -1
}

# The following procs are used as [do_one_faultsim_test] callbacks when 
# injecting IO error faults into test cases.
#
proc ioerr_injectstart {persist iFail} {
  set ::sqlite_io_error_persist $persist
  set ::sqlite_io_error_pending $iFail
}
proc ioerr_injectstop {} {
  set sv $::sqlite_io_error_hit
  set ::sqlite_io_error_persist 0
  set ::sqlite_io_error_pending 0
  set ::sqlite_io_error_hardhit 0
  set ::sqlite_io_error_hit     0
  set ::sqlite_io_error_pending 0
  return $sv
}

# The following procs are used as [do_one_faultsim_test] callbacks when 
# injecting shared-memory related error faults into test cases.
#
proc shmerr_injectinstall {} {
  testvfs shmfault -default true
}
proc shmerr_injectuninstall {} {
  catch {db  close}
  catch {db2 close}
  shmfault delete
}
proc shmerr_injectstart {persist iFail} {
  shmfault ioerr $iFail $persist
}
proc shmerr_injectstop {} {
  shmfault ioerr 0 0
}

# This command is not called directly. It is used by the 
# [faultsim_test_result] command created by [do_faultsim_test] and used
# by -test scripts.
#
proc faultsim_test_result_int {args} {
  upvar testrc testrc testresult testresult testnfail testnfail

#     -injectstart      Script to enable fault-injection.
#
#     -injectstop       Script to disable fault-injection.
#
#     -injecterrlist    List of generally acceptable test results (i.e. error
#                       messages). Example: [list {1 {out of memory}}]
#
#     -injectinstall
#
#     -injectuninstall
#
#     -prep             Script to execute before -body.
#
#     -body             Script to execute (with fault injection).
#
#     -test             Script to execute after -body.
#
proc do_one_faultsim_test {testname args} {

  set DEFAULT(-injectstart)     "expr"
  set DEFAULT(-injectstop)      "expr 0"
  set DEFAULT(-injecterrlist)   [list]
  set DEFAULT(-injectinstall)   ""
  set DEFAULT(-injectuninstall) ""
  set DEFAULT(-prep)            ""
  set DEFAULT(-body)            ""
  set DEFAULT(-test)            ""

  array set O [array get DEFAULT]
  array set O $args
  foreach o [array names O] {
    if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
  }

  proc faultsim_test_proc {testrc testresult testnfail} $O(-test)
  proc faultsim_test_result {args} "
    uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
  "

  eval $O(-injectinstall)

  set stop 0
  for {set iFail 1} {!$stop} {incr iFail} {

    # Evaluate the -prep script.
    #
    eval $O(-prep)

    do_test $testname.$iFail [list list $rc $res] {0 ok}

    # If no faults where injected this trial, don't bother running
    # any more. This test is finished.
    #
    if {$nfail==0} { set stop 1 }
  }

  eval $O(-injectuninstall)
}

# Usage: do_malloc_test <test number> <options...>
#
# The first argument, <test number>, is an integer used to name the
# tests executed by this proc. Options are as follows:
#

#      header).
#
#   3. Check that the reader recovers the wal-index and reads the correct
#      database content.
#
do_test wal2-1.0 {
  proc tvfs_cb {method args} { return SQLITE_OK }
  testvfs tvfs
  tvfs script tvfs_cb

  sqlite3 db  test.db -vfs tvfs
  sqlite3 db2 test.db -vfs tvfs

  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE t1(a);

set WRITER [list 0 1 lock exclusive]
set LOCKS  [list \
  {0 1 lock exclusive} {0 1 unlock exclusive} \
  {4 1 lock shared}    {4 1 unlock shared}    \
]
do_test wal2-2.0 {

  testvfs tvfs
  tvfs script tvfs_cb
  proc tvfs_cb {method args} {
    if {$method == "xShmOpen"} { set ::shm_file [lindex $args 0] }
    return SQLITE_OK
  }

  sqlite3 db  test.db -vfs tvfs
  sqlite3 db2 test.db -vfs tvfs

  }

  proc busyhandler x {
    if {$x>3} { unset -nocomplain ::locked }
    return 0
  }

  testvfs tvfs
  tvfs script tvfs_cb
  sqlite3 db test.db -vfs tvfs
  db busy busyhandler

  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE t1(a);
    INSERT INTO t1 VALUES(1);

    CREATE TABLE data(x);
    INSERT INTO data VALUES('need xShmOpen to see this');
    PRAGMA wal_checkpoint;
  }
} {wal}
do_test wal2-4.2 {
  db close

  testvfs tvfs -noshm 1
  sqlite3 db test.db -vfs tvfs
  catchsql { SELECT * FROM data }
} {1 {unable to open database file}}
do_test wal2-4.3 {
  db close

  testvfs tvfs
  sqlite3 db test.db -vfs tvfs
  catchsql { SELECT * FROM data }
} {0 {{need xShmOpen to see this}}}
db close
tvfs delete

#-------------------------------------------------------------------------

  proc tvfs_cb {method args} {
    set ::shm_file [lindex $args 0]
    if {$method == "xShmLock"} { lappend ::locks [lindex $args 2] }
    return $::tvfs_cb_return
  }
  set tvfs_cb_return SQLITE_OK

  testvfs tvfs
  tvfs script tvfs_cb

  sqlite3 db test.db -vfs tvfs
  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE x(y);
    INSERT INTO x VALUES(1);
  }

do_test wal2-6.4.1 {
  file delete -force test.db test.db-wal test.db-journal
  proc tvfs_cb {method args} {
    set ::shm_file [lindex $args 0]
    if {$method == "xShmLock"} { lappend ::locks [lindex $args 2] }
    return "SQLITE_OK"
  }
  testvfs tvfs
  tvfs script tvfs_cb
  sqlite3 db test.db -vfs tvfs
} {}

set RECOVERY {
  {0 1 lock exclusive} {1 7 lock exclusive} 
  {1 7 unlock exclusive} {0 1 unlock exclusive}
}

  execsql { SELECT count(*) FROM x }
} {8}
do_faultsim_test walfault-2 -prep {
  faultsim_restore_and_reopen
} -body {
  execsql { SELECT count(*) FROM x }
} -test {

  faultsim_test_result {0 8}



  faultsim_integrity_check

}

#--------------------------------------------------------------------------
# Test fault injection while writing and checkpointing a small WAL file.
#
do_test walfault-3-pre-1 {
  sqlite3 db test.db

    DELETE FROM abc;
    PRAGMA wal_checkpoint;
  }
} -test {
  faultsim_test_result {0 {}}
}

file delete -force test.db test.db-wal test.db-journal









faultsim_save_and_close
do_faultsim_test walfault-4 -prep {


  faultsim_restore_and_reopen



} -body {



  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE t1(a PRIMARY KEY, b);
    INSERT INTO t1 VALUES('a', 'b');
    PRAGMA wal_checkpoint;
    SELECT * FROM t1;
  }

} -test {
  faultsim_test_result {0 {wal a b}}







  faultsim_integrity_check






} 






do_test walfault-5-pre-1 {

  catch { db close }
  file delete -force test.db test.db-wal test.db-journal
  sqlite3 db test.db


  execsql {




    PRAGMA page_size = 512;

    PRAGMA journal_mode = WAL;


  }



  faultsim_save_and_close

} {}
do_faultsim_test walfault-5 -faults shmerr* -prep {






  faultsim_restore_and_reopen



  execsql { PRAGMA wal_autocheckpoint = 0 }
  shmfault filter xShmSize
} -body {
  execsql {
    CREATE TABLE t1(x);
    BEGIN;
      INSERT INTO t1 VALUES(randomblob(400));           /* 1 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 2 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 4 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 8 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 16 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 32 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 64 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 128 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 256 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 512 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 1024 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 2048 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 4096 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 8192 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 16384 */
    COMMIT;
    SELECT count(*) FROM t1;
  }
} -test {
  faultsim_test_result {0 16384}
  faultsim_integrity_check
}


do_test walfault-6-pre-1 {
  catch { db close }
  file delete -force test.db test.db-wal test.db-journal
  sqlite3 db test.db

  execsql {
    PRAGMA page_size = 512;
    PRAGMA journal_mode = WAL;
    PRAGMA wal_autocheckpoint = 0;
    CREATE TABLE t1(x);
    BEGIN;
      INSERT INTO t1 VALUES(randomblob(400));           /* 1 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 2 */

      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 1024 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 2048 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 4096 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 8192 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 16384 */
    COMMIT;
  }
  faultsim_save_and_close
} {}
do_faultsim_test walfault-6 -faults shmerr* -prep {
  faultsim_restore_and_reopen

  shmfault filter xShmSize
} -body {
  execsql { SELECT count(*) FROM t1 }

} -test {
  faultsim_test_result {0 16384}
  faultsim_integrity_check
  set n [db one {SELECT count(*) FROM t1}]
  if {$n != 16384 && $n != 0} { error "Incorrect number of rows: $n" }
}

do_test walfault-7-pre-1 {
  faultsim_delete_and_reopen

  execsql {
    PRAGMA page_size = 512;
    PRAGMA journal_mode = WAL;
    PRAGMA wal_autocheckpoint = 0;
    CREATE TABLE t1(x);
    BEGIN;
      INSERT INTO t1 VALUES(randomblob(400));           /* 1 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 2 */
      INSERT INTO t1 SELECT randomblob(400) FROM t1;    /* 4 */
    COMMIT;
  }
  faultsim_save_and_close


} {}
do_faultsim_test walfault-7 -prep {

  faultsim_restore_and_reopen
} -body {
  execsql { SELECT count(*) FROM t1 }
} -test {
  faultsim_test_result {0 4}
  set n [db one {SELECT count(*) FROM t1}]
  if {$n != 4 && $n != 0} { error "Incorrect number of rows: $n" }
}

do_test walfault-8-pre-1 {

  faultsim_delete_and_reopen
  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE abc(a PRIMARY KEY);
    INSERT INTO abc VALUES(randomblob(900));
  }
  faultsim_save_and_close
} {}
do_faultsim_test walfault-8 -prep {
  faultsim_restore_and_reopen
  execsql { PRAGMA cache_size = 10 }
} -body {
  execsql {
    BEGIN;
      INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 1 */
      --INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 2 */
      --INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 4 */
      --INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 8 */
    ROLLBACK;
    SELECT count(*) FROM abc;
  }
} -test {
  faultsim_test_result {0 1}

  faultsim_integrity_check
  catch { db eval ROLLBACK }
  faultsim_integrity_check

  set n [db one {SELECT count(*) FROM abc}]
  if {$n != 1} { error "Incorrect number of rows: $n" }
}

do_test walfault-9-pre-1 {
  faultsim_delete_and_reopen
  execsql {
    PRAGMA journal_mode = WAL;
    CREATE TABLE abc(a PRIMARY KEY);
    INSERT INTO abc VALUES(randomblob(900));
  }
  faultsim_save_and_close
} {}
do_faultsim_test walfault-9 -prep {
  #if {$iFail<73} { set iFail 73 }
  #if {$iFail>73} { exit }
  
  faultsim_restore_and_reopen
  execsql { PRAGMA cache_size = 10 }
} -body {
  execsql {
    BEGIN;
      INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 1 */
      SAVEPOINT spoint;
        INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 2 */
        INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 4 */
        INSERT INTO abc SELECT randomblob(900) FROM abc;    /* 8 */
      ROLLBACK TO spoint;
    COMMIT;
    SELECT count(*) FROM abc;
  }
} -test {
  faultsim_test_result {0 2}
  faultsim_integrity_check

  catch { db eval { ROLLBACK TO spoint } }
  catch { db eval { COMMIT } }
  set n [db one {SELECT count(*) FROM abc}]
  if {$n != 1 && $n != 2} { error "Incorrect number of rows: $n" }
}

#-------------------------------------------------------------------------
# When a database is checkpointed, SQLite does the following:
#
#   1. xShmLock(CHECKPOINT) to lock the WAL.
#   2. xShmGet(-1) to get a mapping to read the wal-index header.

      }
    }
  }
  return SQLITE_OK
}
do_test walfault-shm-6.1 {
  set ::shm_state 0
  testvfs tvfs 
  tvfs script shmfault_vfs_cb_6

  sqlite3 db  test.db -vfs tvfs
  sqlite3 db2 test.db -vfs tvfs

  execsql {
    PRAGMA journal_mode = WAL;
    PRAGMA wal_autocheckpoint = 0;