SQLite

      (iArg1==0 ? SQLITE_SHM_SHARED : SQLITE_SHM_EXCLUSIVE)
    | (iArg2==0 ? SQLITE_SHM_LOCK : SQLITE_SHM_UNLOCK)
  );
  Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3ErrName(rc), -1));
  return TCL_OK;
}

static int SQLITE_TCLAPI test_vfs_set_readmark(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  sqlite3 *db = 0;
  int rc = SQLITE_OK;
  const char *zDbname = 0;
  int iSlot = 0;
  int iVal = -1;
  sqlite3_file *pFd;
  void volatile *pShm = 0;
  u32 *aShm;
  int iOff;

  if( objc!=4 && objc!=5 ){
    Tcl_WrongNumArgs(interp, 1, objv, "DB DBNAME SLOT ?VALUE?");
    return TCL_ERROR;
  }

  zDbname = Tcl_GetString(objv[2]);
  if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) 
   || Tcl_GetIntFromObj(interp, objv[3], &iSlot)
   || (objc==5 && Tcl_GetIntFromObj(interp, objv[4], &iVal))
  ){
    return TCL_ERROR;
  }

  sqlite3_file_control(db, zDbname, SQLITE_FCNTL_FILE_POINTER, (void*)&pFd);
  if( pFd==0 ){
    return TCL_ERROR;
  }
  rc = pFd->pMethods->xShmMap(pFd, 0, 32*1024, 0, &pShm);
  if( rc!=SQLITE_OK ){
    Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3ErrName(rc), -1));
    return TCL_ERROR;
  }
  if( pShm==0 ){
    Tcl_AppendResult(interp, "*-shm is not yet mapped", 0);
    return TCL_ERROR;
  }
  aShm = (u32*)pShm;
  iOff = 12*2+1+iSlot;

  if( objc==5 ){
    aShm[iOff] = iVal;
  }
  Tcl_SetObjResult(interp, Tcl_NewIntObj(aShm[iOff]));

  return TCL_OK;
}

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

#endif

  }
  return SQLITE_OK
}
do_catchsql_test 4.2 {
  SELECT count(*) FROM t1
} {1 {attempt to write a readonly database}}

#-------------------------------------------------------------------------
#
reset_db
db close 
sqlite3 db test.db -vfs tvfs
tvfs filter {}
do_execsql_test 5.0 {
  PRAGMA auto_vacuum = 0;
  PRAGMA page_size = 1024;
  CREATE TABLE t1(x);
  PRAGMA journal_mode = wal;
  WITH s(i) AS (
      SELECT 1 UNION ALL SELECT i+1 FROM s LIMIT 20
  )
  INSERT INTO t1 SELECT randomblob(750) FROM s;
} {wal}

do_execsql_test 5.1 {
  SELECT count(*) FROM t1
} {20}

do_test 5.2 {
  vfs_set_readmark db main 1 100
  vfs_set_readmark db main 2 100
  vfs_set_readmark db main 3 100
  vfs_set_readmark db main 4 100
} {100}

do_execsql_test 5.3 {
  SELECT count(*) FROM t1
} {20}

do_test 5.3 {
  list [vfs_set_readmark db main 1] \
       [vfs_set_readmark db main 2] \
       [vfs_set_readmark db main 3] \
       [vfs_set_readmark db main 4] 
} {24 100 100 100}

tvfs script xShmLock
tvfs filter xShmLock
set ::cnt 20
proc xShmLock {args} {
  incr ::cnt -1
  if {$::cnt>0} { return SQLITE_BUSY }
  return SQLITE_OK
}

do_test 5.4 {
  vfs_set_readmark db main 1 100
  execsql { SELECT count(*) FROM t1 }
} {20}

#-------------------------------------------------------------------------
# Cause an SQLITE_PROTOCOL while attempting to restart the wal file.
reset_db
tvfs filter {}
db close
sqlite3 db test.db -vfs tvfs
do_execsql_test 6.0 {
  PRAGMA auto_vacuum = 0;
  PRAGMA page_size = 1024;
  CREATE TABLE t1(x);
  PRAGMA journal_mode = wal;
  WITH s(i) AS (
      SELECT 1 UNION ALL SELECT i+1 FROM s LIMIT 20
  )
  INSERT INTO t1 SELECT randomblob(750) FROM s;
} {wal}

do_test 6.1 {
  execsql { PRAGMA wal_checkpoint } 
  set {} {}
} {}

tvfs filter xShmLock
set ::flag 0
proc xShmLock {method file handle spec} {
  if {$::flag && [lrange $spec 2 end]=="lock shared"} {
    return SQLITE_BUSY
  }
  if {$spec=="3 1 unlock shared"} {
    set ::flag 1
  }
  return SQLITE_OK
}

puts "# WARNING: This next test takes around 12 seconds"
do_catchsql_test 6.2 {
  INSERT INTO t1 VALUES(1);
} {1 {locking protocol}}

db close
tvfs delete
finish_test