xref: /sqlite-3.40.0/src/test_vfs.c (revision f2fcd075)
1 /*
2 ** 2010 May 05
3 **
4 ** The author disclaims copyright to this source code.  In place of
5 ** a legal notice, here is a blessing:
6 **
7 **    May you do good and not evil.
8 **    May you find forgiveness for yourself and forgive others.
9 **    May you share freely, never taking more than you give.
10 **
11 ******************************************************************************
12 **
13 */
14 #if SQLITE_TEST          /* This file is used for testing only */
15 
16 /*
17 ** This file contains the implementation of the Tcl [testvfs] command,
18 ** used to create SQLite VFS implementations with various properties and
19 ** instrumentation to support testing SQLite.
20 **
21 **   testvfs VFSNAME ?OPTIONS?
22 **
23 ** Available options are:
24 **
25 **   -noshm      BOOLEAN        (True to omit shm methods. Default false)
26 **   -default    BOOLEAN        (True to make the vfs default. Default false)
27 **   -szosfile   INTEGER        (Value for sqlite3_vfs.szOsFile)
28 **   -mxpathname INTEGER        (Value for sqlite3_vfs.mxPathname)
29 */
30 
31 #include "sqlite3.h"
32 #include "sqliteInt.h"
33 
34 typedef struct Testvfs Testvfs;
35 typedef struct TestvfsShm TestvfsShm;
36 typedef struct TestvfsBuffer TestvfsBuffer;
37 typedef struct TestvfsFile TestvfsFile;
38 typedef struct TestvfsFd TestvfsFd;
39 
40 /*
41 ** An open file handle.
42 */
43 struct TestvfsFile {
44   sqlite3_file base;              /* Base class.  Must be first */
45   TestvfsFd *pFd;                 /* File data */
46 };
47 #define tvfsGetFd(pFile) (((TestvfsFile *)pFile)->pFd)
48 
49 struct TestvfsFd {
50   sqlite3_vfs *pVfs;              /* The VFS */
51   const char *zFilename;          /* Filename as passed to xOpen() */
52   sqlite3_file *pReal;            /* The real, underlying file descriptor */
53   Tcl_Obj *pShmId;                /* Shared memory id for Tcl callbacks */
54 
55   TestvfsBuffer *pShm;            /* Shared memory buffer */
56   u32 excllock;                   /* Mask of exclusive locks */
57   u32 sharedlock;                 /* Mask of shared locks */
58   TestvfsFd *pNext;               /* Next handle opened on the same file */
59 };
60 
61 
62 #define FAULT_INJECT_NONE       0
63 #define FAULT_INJECT_TRANSIENT  1
64 #define FAULT_INJECT_PERSISTENT 2
65 
66 typedef struct TestFaultInject TestFaultInject;
67 struct TestFaultInject {
68   int iCnt;                       /* Remaining calls before fault injection */
69   int eFault;                     /* A FAULT_INJECT_* value */
70   int nFail;                      /* Number of faults injected */
71 };
72 
73 /*
74 ** An instance of this structure is allocated for each VFS created. The
75 ** sqlite3_vfs.pAppData field of the VFS structure registered with SQLite
76 ** is set to point to it.
77 */
78 struct Testvfs {
79   char *zName;                    /* Name of this VFS */
80   sqlite3_vfs *pParent;           /* The VFS to use for file IO */
81   sqlite3_vfs *pVfs;              /* The testvfs registered with SQLite */
82   Tcl_Interp *interp;             /* Interpreter to run script in */
83   Tcl_Obj *pScript;               /* Script to execute */
84   int nScript;                    /* Number of elements in array apScript */
85   Tcl_Obj **apScript;             /* Array version of pScript */
86   TestvfsBuffer *pBuffer;         /* List of shared buffers */
87   int isNoshm;
88 
89   int mask;                       /* Mask controlling [script] and [ioerr] */
90 
91   TestFaultInject ioerr_err;
92   TestFaultInject full_err;
93   TestFaultInject cantopen_err;
94 
95 #if 0
96   int iIoerrCnt;
97   int ioerr;
98   int nIoerrFail;
99   int iFullCnt;
100   int fullerr;
101   int nFullFail;
102 #endif
103 
104   int iDevchar;
105   int iSectorsize;
106 };
107 
108 /*
109 ** The Testvfs.mask variable is set to a combination of the following.
110 ** If a bit is clear in Testvfs.mask, then calls made by SQLite to the
111 ** corresponding VFS method is ignored for purposes of:
112 **
113 **   + Simulating IO errors, and
114 **   + Invoking the Tcl callback script.
115 */
116 #define TESTVFS_SHMOPEN_MASK    0x00000001
117 #define TESTVFS_SHMLOCK_MASK    0x00000010
118 #define TESTVFS_SHMMAP_MASK     0x00000020
119 #define TESTVFS_SHMBARRIER_MASK 0x00000040
120 #define TESTVFS_SHMCLOSE_MASK   0x00000080
121 
122 #define TESTVFS_OPEN_MASK       0x00000100
123 #define TESTVFS_SYNC_MASK       0x00000200
124 #define TESTVFS_DELETE_MASK     0x00000400
125 #define TESTVFS_CLOSE_MASK      0x00000800
126 #define TESTVFS_WRITE_MASK      0x00001000
127 #define TESTVFS_TRUNCATE_MASK   0x00002000
128 #define TESTVFS_ACCESS_MASK     0x00004000
129 #define TESTVFS_ALL_MASK        0x00007FFF
130 
131 
132 #define TESTVFS_MAX_PAGES 1024
133 
134 /*
135 ** A shared-memory buffer. There is one of these objects for each shared
136 ** memory region opened by clients. If two clients open the same file,
137 ** there are two TestvfsFile structures but only one TestvfsBuffer structure.
138 */
139 struct TestvfsBuffer {
140   char *zFile;                    /* Associated file name */
141   int pgsz;                       /* Page size */
142   u8 *aPage[TESTVFS_MAX_PAGES];   /* Array of ckalloc'd pages */
143   TestvfsFd *pFile;               /* List of open handles */
144   TestvfsBuffer *pNext;           /* Next in linked list of all buffers */
145 };
146 
147 
148 #define PARENTVFS(x) (((Testvfs *)((x)->pAppData))->pParent)
149 
150 #define TESTVFS_MAX_ARGS 12
151 
152 
153 /*
154 ** Method declarations for TestvfsFile.
155 */
156 static int tvfsClose(sqlite3_file*);
157 static int tvfsRead(sqlite3_file*, void*, int iAmt, sqlite3_int64 iOfst);
158 static int tvfsWrite(sqlite3_file*,const void*,int iAmt, sqlite3_int64 iOfst);
159 static int tvfsTruncate(sqlite3_file*, sqlite3_int64 size);
160 static int tvfsSync(sqlite3_file*, int flags);
161 static int tvfsFileSize(sqlite3_file*, sqlite3_int64 *pSize);
162 static int tvfsLock(sqlite3_file*, int);
163 static int tvfsUnlock(sqlite3_file*, int);
164 static int tvfsCheckReservedLock(sqlite3_file*, int *);
165 static int tvfsFileControl(sqlite3_file*, int op, void *pArg);
166 static int tvfsSectorSize(sqlite3_file*);
167 static int tvfsDeviceCharacteristics(sqlite3_file*);
168 
169 /*
170 ** Method declarations for tvfs_vfs.
171 */
172 static int tvfsOpen(sqlite3_vfs*, const char *, sqlite3_file*, int , int *);
173 static int tvfsDelete(sqlite3_vfs*, const char *zName, int syncDir);
174 static int tvfsAccess(sqlite3_vfs*, const char *zName, int flags, int *);
175 static int tvfsFullPathname(sqlite3_vfs*, const char *zName, int, char *zOut);
176 #ifndef SQLITE_OMIT_LOAD_EXTENSION
177 static void *tvfsDlOpen(sqlite3_vfs*, const char *zFilename);
178 static void tvfsDlError(sqlite3_vfs*, int nByte, char *zErrMsg);
179 static void (*tvfsDlSym(sqlite3_vfs*,void*, const char *zSymbol))(void);
180 static void tvfsDlClose(sqlite3_vfs*, void*);
181 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
182 static int tvfsRandomness(sqlite3_vfs*, int nByte, char *zOut);
183 static int tvfsSleep(sqlite3_vfs*, int microseconds);
184 static int tvfsCurrentTime(sqlite3_vfs*, double*);
185 
186 static int tvfsShmOpen(sqlite3_file*);
187 static int tvfsShmLock(sqlite3_file*, int , int, int);
188 static int tvfsShmMap(sqlite3_file*,int,int,int, void volatile **);
189 static void tvfsShmBarrier(sqlite3_file*);
190 static int tvfsShmUnmap(sqlite3_file*, int);
191 
192 static sqlite3_io_methods tvfs_io_methods = {
193   2,                              /* iVersion */
194   tvfsClose,                      /* xClose */
195   tvfsRead,                       /* xRead */
196   tvfsWrite,                      /* xWrite */
197   tvfsTruncate,                   /* xTruncate */
198   tvfsSync,                       /* xSync */
199   tvfsFileSize,                   /* xFileSize */
200   tvfsLock,                       /* xLock */
201   tvfsUnlock,                     /* xUnlock */
202   tvfsCheckReservedLock,          /* xCheckReservedLock */
203   tvfsFileControl,                /* xFileControl */
204   tvfsSectorSize,                 /* xSectorSize */
205   tvfsDeviceCharacteristics,      /* xDeviceCharacteristics */
206   tvfsShmMap,                     /* xShmMap */
207   tvfsShmLock,                    /* xShmLock */
208   tvfsShmBarrier,                 /* xShmBarrier */
209   tvfsShmUnmap                    /* xShmUnmap */
210 };
211 
212 static int tvfsResultCode(Testvfs *p, int *pRc){
213   struct errcode {
214     int eCode;
215     const char *zCode;
216   } aCode[] = {
217     { SQLITE_OK,     "SQLITE_OK"     },
218     { SQLITE_ERROR,  "SQLITE_ERROR"  },
219     { SQLITE_IOERR,  "SQLITE_IOERR"  },
220     { SQLITE_LOCKED, "SQLITE_LOCKED" },
221     { SQLITE_BUSY,   "SQLITE_BUSY"   },
222   };
223 
224   const char *z;
225   int i;
226 
227   z = Tcl_GetStringResult(p->interp);
228   for(i=0; i<ArraySize(aCode); i++){
229     if( 0==strcmp(z, aCode[i].zCode) ){
230       *pRc = aCode[i].eCode;
231       return 1;
232     }
233   }
234 
235   return 0;
236 }
237 
238 static int tvfsInjectFault(TestFaultInject *p){
239   int ret = 0;
240   if( p->eFault ){
241     p->iCnt--;
242     if( p->iCnt==0 || (p->iCnt<0 && p->eFault==FAULT_INJECT_PERSISTENT ) ){
243       ret = 1;
244       p->nFail++;
245     }
246   }
247   return ret;
248 }
249 
250 
251 static int tvfsInjectIoerr(Testvfs *p){
252   return tvfsInjectFault(&p->ioerr_err);
253 }
254 
255 static int tvfsInjectFullerr(Testvfs *p){
256   return tvfsInjectFault(&p->full_err);
257 }
258 static int tvfsInjectCantopenerr(Testvfs *p){
259   return tvfsInjectFault(&p->cantopen_err);
260 }
261 
262 
263 static void tvfsExecTcl(
264   Testvfs *p,
265   const char *zMethod,
266   Tcl_Obj *arg1,
267   Tcl_Obj *arg2,
268   Tcl_Obj *arg3
269 ){
270   int rc;                         /* Return code from Tcl_EvalObj() */
271   int nArg;                       /* Elements in eval'd list */
272   int nScript;
273   Tcl_Obj ** ap;
274 
275   assert( p->pScript );
276 
277   if( !p->apScript ){
278     int nByte;
279     int i;
280     if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
281       Tcl_BackgroundError(p->interp);
282       Tcl_ResetResult(p->interp);
283       return;
284     }
285     p->nScript = nScript;
286     nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
287     p->apScript = (Tcl_Obj **)ckalloc(nByte);
288     memset(p->apScript, 0, nByte);
289     for(i=0; i<nScript; i++){
290       p->apScript[i] = ap[i];
291     }
292   }
293 
294   p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
295   p->apScript[p->nScript+1] = arg1;
296   p->apScript[p->nScript+2] = arg2;
297   p->apScript[p->nScript+3] = arg3;
298 
299   for(nArg=p->nScript; p->apScript[nArg]; nArg++){
300     Tcl_IncrRefCount(p->apScript[nArg]);
301   }
302 
303   rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
304   if( rc!=TCL_OK ){
305     Tcl_BackgroundError(p->interp);
306     Tcl_ResetResult(p->interp);
307   }
308 
309   for(nArg=p->nScript; p->apScript[nArg]; nArg++){
310     Tcl_DecrRefCount(p->apScript[nArg]);
311     p->apScript[nArg] = 0;
312   }
313 }
314 
315 
316 /*
317 ** Close an tvfs-file.
318 */
319 static int tvfsClose(sqlite3_file *pFile){
320   int rc;
321   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
322   TestvfsFd *pFd = pTestfile->pFd;
323   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
324 
325   if( p->pScript && p->mask&TESTVFS_CLOSE_MASK ){
326     tvfsExecTcl(p, "xClose",
327         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
328     );
329   }
330 
331   if( pFd->pShmId ){
332     Tcl_DecrRefCount(pFd->pShmId);
333     pFd->pShmId = 0;
334   }
335   if( pFile->pMethods ){
336     ckfree((char *)pFile->pMethods);
337   }
338   rc = sqlite3OsClose(pFd->pReal);
339   ckfree((char *)pFd);
340   pTestfile->pFd = 0;
341   return rc;
342 }
343 
344 /*
345 ** Read data from an tvfs-file.
346 */
347 static int tvfsRead(
348   sqlite3_file *pFile,
349   void *zBuf,
350   int iAmt,
351   sqlite_int64 iOfst
352 ){
353   TestvfsFd *p = tvfsGetFd(pFile);
354   return sqlite3OsRead(p->pReal, zBuf, iAmt, iOfst);
355 }
356 
357 /*
358 ** Write data to an tvfs-file.
359 */
360 static int tvfsWrite(
361   sqlite3_file *pFile,
362   const void *zBuf,
363   int iAmt,
364   sqlite_int64 iOfst
365 ){
366   int rc = SQLITE_OK;
367   TestvfsFd *pFd = tvfsGetFd(pFile);
368   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
369 
370   if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){
371     tvfsExecTcl(p, "xWrite",
372         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
373     );
374     tvfsResultCode(p, &rc);
375   }
376 
377   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){
378     rc = SQLITE_FULL;
379   }
380   if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
381     rc = SQLITE_IOERR;
382   }
383 
384   if( rc==SQLITE_OK ){
385     rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst);
386   }
387   return rc;
388 }
389 
390 /*
391 ** Truncate an tvfs-file.
392 */
393 static int tvfsTruncate(sqlite3_file *pFile, sqlite_int64 size){
394   int rc = SQLITE_OK;
395   TestvfsFd *pFd = tvfsGetFd(pFile);
396   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
397 
398   if( p->pScript && p->mask&TESTVFS_TRUNCATE_MASK ){
399     tvfsExecTcl(p, "xTruncate",
400         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0
401     );
402     tvfsResultCode(p, &rc);
403   }
404 
405   if( rc==SQLITE_OK ){
406     rc = sqlite3OsTruncate(pFd->pReal, size);
407   }
408   return rc;
409 }
410 
411 /*
412 ** Sync an tvfs-file.
413 */
414 static int tvfsSync(sqlite3_file *pFile, int flags){
415   int rc = SQLITE_OK;
416   TestvfsFd *pFd = tvfsGetFd(pFile);
417   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
418 
419   if( p->pScript && p->mask&TESTVFS_SYNC_MASK ){
420     char *zFlags;
421 
422     switch( flags ){
423       case SQLITE_SYNC_NORMAL:
424         zFlags = "normal";
425         break;
426       case SQLITE_SYNC_FULL:
427         zFlags = "full";
428         break;
429       case SQLITE_SYNC_NORMAL|SQLITE_SYNC_DATAONLY:
430         zFlags = "normal|dataonly";
431         break;
432       case SQLITE_SYNC_FULL|SQLITE_SYNC_DATAONLY:
433         zFlags = "full|dataonly";
434         break;
435       default:
436         assert(0);
437     }
438 
439     tvfsExecTcl(p, "xSync",
440         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
441         Tcl_NewStringObj(zFlags, -1)
442     );
443     tvfsResultCode(p, &rc);
444   }
445 
446   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ) rc = SQLITE_FULL;
447 
448   if( rc==SQLITE_OK ){
449     rc = sqlite3OsSync(pFd->pReal, flags);
450   }
451 
452   return rc;
453 }
454 
455 /*
456 ** Return the current file-size of an tvfs-file.
457 */
458 static int tvfsFileSize(sqlite3_file *pFile, sqlite_int64 *pSize){
459   TestvfsFd *p = tvfsGetFd(pFile);
460   return sqlite3OsFileSize(p->pReal, pSize);
461 }
462 
463 /*
464 ** Lock an tvfs-file.
465 */
466 static int tvfsLock(sqlite3_file *pFile, int eLock){
467   TestvfsFd *p = tvfsGetFd(pFile);
468   return sqlite3OsLock(p->pReal, eLock);
469 }
470 
471 /*
472 ** Unlock an tvfs-file.
473 */
474 static int tvfsUnlock(sqlite3_file *pFile, int eLock){
475   TestvfsFd *p = tvfsGetFd(pFile);
476   return sqlite3OsUnlock(p->pReal, eLock);
477 }
478 
479 /*
480 ** Check if another file-handle holds a RESERVED lock on an tvfs-file.
481 */
482 static int tvfsCheckReservedLock(sqlite3_file *pFile, int *pResOut){
483   TestvfsFd *p = tvfsGetFd(pFile);
484   return sqlite3OsCheckReservedLock(p->pReal, pResOut);
485 }
486 
487 /*
488 ** File control method. For custom operations on an tvfs-file.
489 */
490 static int tvfsFileControl(sqlite3_file *pFile, int op, void *pArg){
491   TestvfsFd *p = tvfsGetFd(pFile);
492   return sqlite3OsFileControl(p->pReal, op, pArg);
493 }
494 
495 /*
496 ** Return the sector-size in bytes for an tvfs-file.
497 */
498 static int tvfsSectorSize(sqlite3_file *pFile){
499   TestvfsFd *pFd = tvfsGetFd(pFile);
500   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
501   if( p->iSectorsize>=0 ){
502     return p->iSectorsize;
503   }
504   return sqlite3OsSectorSize(pFd->pReal);
505 }
506 
507 /*
508 ** Return the device characteristic flags supported by an tvfs-file.
509 */
510 static int tvfsDeviceCharacteristics(sqlite3_file *pFile){
511   TestvfsFd *pFd = tvfsGetFd(pFile);
512   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
513   if( p->iDevchar>=0 ){
514     return p->iDevchar;
515   }
516   return sqlite3OsDeviceCharacteristics(pFd->pReal);
517 }
518 
519 /*
520 ** Open an tvfs file handle.
521 */
522 static int tvfsOpen(
523   sqlite3_vfs *pVfs,
524   const char *zName,
525   sqlite3_file *pFile,
526   int flags,
527   int *pOutFlags
528 ){
529   int rc;
530   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
531   TestvfsFd *pFd;
532   Tcl_Obj *pId = 0;
533   Testvfs *p = (Testvfs *)pVfs->pAppData;
534 
535   pFd = (TestvfsFd *)ckalloc(sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
536   memset(pFd, 0, sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
537   pFd->pShm = 0;
538   pFd->pShmId = 0;
539   pFd->zFilename = zName;
540   pFd->pVfs = pVfs;
541   pFd->pReal = (sqlite3_file *)&pFd[1];
542   pTestfile->pFd = pFd;
543 
544   /* Evaluate the Tcl script:
545   **
546   **   SCRIPT xOpen FILENAME
547   **
548   ** If the script returns an SQLite error code other than SQLITE_OK, an
549   ** error is returned to the caller. If it returns SQLITE_OK, the new
550   ** connection is named "anon". Otherwise, the value returned by the
551   ** script is used as the connection name.
552   */
553   Tcl_ResetResult(p->interp);
554   if( p->pScript && p->mask&TESTVFS_OPEN_MASK ){
555     tvfsExecTcl(p, "xOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0);
556     if( tvfsResultCode(p, &rc) ){
557       if( rc!=SQLITE_OK ) return rc;
558     }else{
559       pId = Tcl_GetObjResult(p->interp);
560     }
561   }
562 
563   if( (p->mask&TESTVFS_OPEN_MASK) &&  tvfsInjectIoerr(p) ) return SQLITE_IOERR;
564   if( tvfsInjectCantopenerr(p) ) return SQLITE_CANTOPEN;
565   if( tvfsInjectFullerr(p) ) return SQLITE_FULL;
566 
567   if( !pId ){
568     pId = Tcl_NewStringObj("anon", -1);
569   }
570   Tcl_IncrRefCount(pId);
571   pFd->pShmId = pId;
572   Tcl_ResetResult(p->interp);
573 
574   rc = sqlite3OsOpen(PARENTVFS(pVfs), zName, pFd->pReal, flags, pOutFlags);
575   if( pFd->pReal->pMethods ){
576     sqlite3_io_methods *pMethods;
577     int nByte;
578 
579     if( pVfs->iVersion>1 ){
580       nByte = sizeof(sqlite3_io_methods);
581     }else{
582       nByte = offsetof(sqlite3_io_methods, xShmMap);
583     }
584 
585     pMethods = (sqlite3_io_methods *)ckalloc(nByte);
586     memcpy(pMethods, &tvfs_io_methods, nByte);
587     pMethods->iVersion = pVfs->iVersion;
588     if( pVfs->iVersion>1 && ((Testvfs *)pVfs->pAppData)->isNoshm ){
589       pMethods->xShmUnmap = 0;
590       pMethods->xShmLock = 0;
591       pMethods->xShmBarrier = 0;
592       pMethods->xShmMap = 0;
593     }
594     pFile->pMethods = pMethods;
595   }
596 
597   return rc;
598 }
599 
600 /*
601 ** Delete the file located at zPath. If the dirSync argument is true,
602 ** ensure the file-system modifications are synced to disk before
603 ** returning.
604 */
605 static int tvfsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){
606   int rc = SQLITE_OK;
607   Testvfs *p = (Testvfs *)pVfs->pAppData;
608 
609   if( p->pScript && p->mask&TESTVFS_DELETE_MASK ){
610     tvfsExecTcl(p, "xDelete",
611         Tcl_NewStringObj(zPath, -1), Tcl_NewIntObj(dirSync), 0
612     );
613     tvfsResultCode(p, &rc);
614   }
615   if( rc==SQLITE_OK ){
616     rc = sqlite3OsDelete(PARENTVFS(pVfs), zPath, dirSync);
617   }
618   return rc;
619 }
620 
621 /*
622 ** Test for access permissions. Return true if the requested permission
623 ** is available, or false otherwise.
624 */
625 static int tvfsAccess(
626   sqlite3_vfs *pVfs,
627   const char *zPath,
628   int flags,
629   int *pResOut
630 ){
631   Testvfs *p = (Testvfs *)pVfs->pAppData;
632   if( p->pScript && p->mask&TESTVFS_ACCESS_MASK ){
633     int rc;
634     char *zArg = 0;
635     if( flags==SQLITE_ACCESS_EXISTS ) zArg = "SQLITE_ACCESS_EXISTS";
636     if( flags==SQLITE_ACCESS_READWRITE ) zArg = "SQLITE_ACCESS_READWRITE";
637     if( flags==SQLITE_ACCESS_READ ) zArg = "SQLITE_ACCESS_READ";
638     tvfsExecTcl(p, "xAccess",
639         Tcl_NewStringObj(zPath, -1), Tcl_NewStringObj(zArg, -1), 0
640     );
641     if( tvfsResultCode(p, &rc) ){
642       if( rc!=SQLITE_OK ) return rc;
643     }else{
644       Tcl_Interp *interp = p->interp;
645       if( TCL_OK==Tcl_GetBooleanFromObj(0, Tcl_GetObjResult(interp), pResOut) ){
646         return SQLITE_OK;
647       }
648     }
649   }
650   return sqlite3OsAccess(PARENTVFS(pVfs), zPath, flags, pResOut);
651 }
652 
653 /*
654 ** Populate buffer zOut with the full canonical pathname corresponding
655 ** to the pathname in zPath. zOut is guaranteed to point to a buffer
656 ** of at least (DEVSYM_MAX_PATHNAME+1) bytes.
657 */
658 static int tvfsFullPathname(
659   sqlite3_vfs *pVfs,
660   const char *zPath,
661   int nOut,
662   char *zOut
663 ){
664   return sqlite3OsFullPathname(PARENTVFS(pVfs), zPath, nOut, zOut);
665 }
666 
667 #ifndef SQLITE_OMIT_LOAD_EXTENSION
668 /*
669 ** Open the dynamic library located at zPath and return a handle.
670 */
671 static void *tvfsDlOpen(sqlite3_vfs *pVfs, const char *zPath){
672   return sqlite3OsDlOpen(PARENTVFS(pVfs), zPath);
673 }
674 
675 /*
676 ** Populate the buffer zErrMsg (size nByte bytes) with a human readable
677 ** utf-8 string describing the most recent error encountered associated
678 ** with dynamic libraries.
679 */
680 static void tvfsDlError(sqlite3_vfs *pVfs, int nByte, char *zErrMsg){
681   sqlite3OsDlError(PARENTVFS(pVfs), nByte, zErrMsg);
682 }
683 
684 /*
685 ** Return a pointer to the symbol zSymbol in the dynamic library pHandle.
686 */
687 static void (*tvfsDlSym(sqlite3_vfs *pVfs, void *p, const char *zSym))(void){
688   return sqlite3OsDlSym(PARENTVFS(pVfs), p, zSym);
689 }
690 
691 /*
692 ** Close the dynamic library handle pHandle.
693 */
694 static void tvfsDlClose(sqlite3_vfs *pVfs, void *pHandle){
695   sqlite3OsDlClose(PARENTVFS(pVfs), pHandle);
696 }
697 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
698 
699 /*
700 ** Populate the buffer pointed to by zBufOut with nByte bytes of
701 ** random data.
702 */
703 static int tvfsRandomness(sqlite3_vfs *pVfs, int nByte, char *zBufOut){
704   return sqlite3OsRandomness(PARENTVFS(pVfs), nByte, zBufOut);
705 }
706 
707 /*
708 ** Sleep for nMicro microseconds. Return the number of microseconds
709 ** actually slept.
710 */
711 static int tvfsSleep(sqlite3_vfs *pVfs, int nMicro){
712   return sqlite3OsSleep(PARENTVFS(pVfs), nMicro);
713 }
714 
715 /*
716 ** Return the current time as a Julian Day number in *pTimeOut.
717 */
718 static int tvfsCurrentTime(sqlite3_vfs *pVfs, double *pTimeOut){
719   return PARENTVFS(pVfs)->xCurrentTime(PARENTVFS(pVfs), pTimeOut);
720 }
721 
722 static int tvfsShmOpen(sqlite3_file *pFile){
723   Testvfs *p;
724   int rc = SQLITE_OK;             /* Return code */
725   TestvfsBuffer *pBuffer;         /* Buffer to open connection to */
726   TestvfsFd *pFd;                 /* The testvfs file structure */
727 
728   pFd = tvfsGetFd(pFile);
729   p = (Testvfs *)pFd->pVfs->pAppData;
730   assert( pFd->pShmId && pFd->pShm==0 && pFd->pNext==0 );
731 
732   /* Evaluate the Tcl script:
733   **
734   **   SCRIPT xShmOpen FILENAME
735   */
736   Tcl_ResetResult(p->interp);
737   if( p->pScript && p->mask&TESTVFS_SHMOPEN_MASK ){
738     tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0);
739     if( tvfsResultCode(p, &rc) ){
740       if( rc!=SQLITE_OK ) return rc;
741     }
742   }
743 
744   assert( rc==SQLITE_OK );
745   if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
746     return SQLITE_IOERR;
747   }
748 
749   /* Search for a TestvfsBuffer. Create a new one if required. */
750   for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
751     if( 0==strcmp(pFd->zFilename, pBuffer->zFile) ) break;
752   }
753   if( !pBuffer ){
754     int nByte = sizeof(TestvfsBuffer) + strlen(pFd->zFilename) + 1;
755     pBuffer = (TestvfsBuffer *)ckalloc(nByte);
756     memset(pBuffer, 0, nByte);
757     pBuffer->zFile = (char *)&pBuffer[1];
758     strcpy(pBuffer->zFile, pFd->zFilename);
759     pBuffer->pNext = p->pBuffer;
760     p->pBuffer = pBuffer;
761   }
762 
763   /* Connect the TestvfsBuffer to the new TestvfsShm handle and return. */
764   pFd->pNext = pBuffer->pFile;
765   pBuffer->pFile = pFd;
766   pFd->pShm = pBuffer;
767   return SQLITE_OK;
768 }
769 
770 static void tvfsAllocPage(TestvfsBuffer *p, int iPage, int pgsz){
771   assert( iPage<TESTVFS_MAX_PAGES );
772   if( p->aPage[iPage]==0 ){
773     p->aPage[iPage] = (u8 *)ckalloc(pgsz);
774     memset(p->aPage[iPage], 0, pgsz);
775     p->pgsz = pgsz;
776   }
777 }
778 
779 static int tvfsShmMap(
780   sqlite3_file *pFile,            /* Handle open on database file */
781   int iPage,                      /* Page to retrieve */
782   int pgsz,                       /* Size of pages */
783   int isWrite,                    /* True to extend file if necessary */
784   void volatile **pp              /* OUT: Mapped memory */
785 ){
786   int rc = SQLITE_OK;
787   TestvfsFd *pFd = tvfsGetFd(pFile);
788   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
789 
790   if( 0==pFd->pShm ){
791     rc = tvfsShmOpen(pFile);
792     if( rc!=SQLITE_OK ){
793       return rc;
794     }
795   }
796 
797   if( p->pScript && p->mask&TESTVFS_SHMMAP_MASK ){
798     Tcl_Obj *pArg = Tcl_NewObj();
799     Tcl_IncrRefCount(pArg);
800     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(iPage));
801     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(pgsz));
802     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(isWrite));
803     tvfsExecTcl(p, "xShmMap",
804         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, pArg
805     );
806     tvfsResultCode(p, &rc);
807     Tcl_DecrRefCount(pArg);
808   }
809   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMMAP_MASK && tvfsInjectIoerr(p) ){
810     rc = SQLITE_IOERR;
811   }
812 
813   if( rc==SQLITE_OK && isWrite && !pFd->pShm->aPage[iPage] ){
814     tvfsAllocPage(pFd->pShm, iPage, pgsz);
815   }
816   *pp = (void volatile *)pFd->pShm->aPage[iPage];
817 
818   return rc;
819 }
820 
821 
822 static int tvfsShmLock(
823   sqlite3_file *pFile,
824   int ofst,
825   int n,
826   int flags
827 ){
828   int rc = SQLITE_OK;
829   TestvfsFd *pFd = tvfsGetFd(pFile);
830   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
831   int nLock;
832   char zLock[80];
833 
834   if( p->pScript && p->mask&TESTVFS_SHMLOCK_MASK ){
835     sqlite3_snprintf(sizeof(zLock), zLock, "%d %d", ofst, n);
836     nLock = strlen(zLock);
837     if( flags & SQLITE_SHM_LOCK ){
838       strcpy(&zLock[nLock], " lock");
839     }else{
840       strcpy(&zLock[nLock], " unlock");
841     }
842     nLock += strlen(&zLock[nLock]);
843     if( flags & SQLITE_SHM_SHARED ){
844       strcpy(&zLock[nLock], " shared");
845     }else{
846       strcpy(&zLock[nLock], " exclusive");
847     }
848     tvfsExecTcl(p, "xShmLock",
849         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId,
850         Tcl_NewStringObj(zLock, -1)
851     );
852     tvfsResultCode(p, &rc);
853   }
854 
855   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMLOCK_MASK && tvfsInjectIoerr(p) ){
856     rc = SQLITE_IOERR;
857   }
858 
859   if( rc==SQLITE_OK ){
860     int isLock = (flags & SQLITE_SHM_LOCK);
861     int isExcl = (flags & SQLITE_SHM_EXCLUSIVE);
862     u32 mask = (((1<<n)-1) << ofst);
863     if( isLock ){
864       TestvfsFd *p2;
865       for(p2=pFd->pShm->pFile; p2; p2=p2->pNext){
866         if( p2==pFd ) continue;
867         if( (p2->excllock&mask) || (isExcl && p2->sharedlock&mask) ){
868           rc = SQLITE_BUSY;
869           break;
870         }
871       }
872       if( rc==SQLITE_OK ){
873         if( isExcl )  pFd->excllock |= mask;
874         if( !isExcl ) pFd->sharedlock |= mask;
875       }
876     }else{
877       if( isExcl )  pFd->excllock &= (~mask);
878       if( !isExcl ) pFd->sharedlock &= (~mask);
879     }
880   }
881 
882   return rc;
883 }
884 
885 static void tvfsShmBarrier(sqlite3_file *pFile){
886   TestvfsFd *pFd = tvfsGetFd(pFile);
887   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
888 
889   if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
890     tvfsExecTcl(p, "xShmBarrier",
891         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
892     );
893   }
894 }
895 
896 static int tvfsShmUnmap(
897   sqlite3_file *pFile,
898   int deleteFlag
899 ){
900   int rc = SQLITE_OK;
901   TestvfsFd *pFd = tvfsGetFd(pFile);
902   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
903   TestvfsBuffer *pBuffer = pFd->pShm;
904   TestvfsFd **ppFd;
905 
906   if( !pBuffer ) return SQLITE_OK;
907   assert( pFd->pShmId && pFd->pShm );
908 
909   if( p->pScript && p->mask&TESTVFS_SHMCLOSE_MASK ){
910     tvfsExecTcl(p, "xShmUnmap",
911         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0
912     );
913     tvfsResultCode(p, &rc);
914   }
915 
916   for(ppFd=&pBuffer->pFile; *ppFd!=pFd; ppFd=&((*ppFd)->pNext));
917   assert( (*ppFd)==pFd );
918   *ppFd = pFd->pNext;
919   pFd->pNext = 0;
920 
921   if( pBuffer->pFile==0 ){
922     int i;
923     TestvfsBuffer **pp;
924     for(pp=&p->pBuffer; *pp!=pBuffer; pp=&((*pp)->pNext));
925     *pp = (*pp)->pNext;
926     for(i=0; pBuffer->aPage[i]; i++){
927       ckfree((char *)pBuffer->aPage[i]);
928     }
929     ckfree((char *)pBuffer);
930   }
931   pFd->pShm = 0;
932 
933   return rc;
934 }
935 
936 static int testvfs_obj_cmd(
937   ClientData cd,
938   Tcl_Interp *interp,
939   int objc,
940   Tcl_Obj *CONST objv[]
941 ){
942   Testvfs *p = (Testvfs *)cd;
943 
944   enum DB_enum {
945     CMD_SHM, CMD_DELETE, CMD_FILTER, CMD_IOERR, CMD_SCRIPT,
946     CMD_DEVCHAR, CMD_SECTORSIZE, CMD_FULLERR, CMD_CANTOPENERR
947   };
948   struct TestvfsSubcmd {
949     char *zName;
950     enum DB_enum eCmd;
951   } aSubcmd[] = {
952     { "shm",         CMD_SHM         },
953     { "delete",      CMD_DELETE      },
954     { "filter",      CMD_FILTER      },
955     { "ioerr",       CMD_IOERR       },
956     { "fullerr",     CMD_FULLERR     },
957     { "cantopenerr", CMD_CANTOPENERR },
958     { "script",      CMD_SCRIPT      },
959     { "devchar",     CMD_DEVCHAR     },
960     { "sectorsize",  CMD_SECTORSIZE  },
961     { 0, 0 }
962   };
963   int i;
964 
965   if( objc<2 ){
966     Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
967     return TCL_ERROR;
968   }
969   if( Tcl_GetIndexFromObjStruct(
970         interp, objv[1], aSubcmd, sizeof(aSubcmd[0]), "subcommand", 0, &i)
971   ){
972     return TCL_ERROR;
973   }
974   Tcl_ResetResult(interp);
975 
976   switch( aSubcmd[i].eCmd ){
977     case CMD_SHM: {
978       Tcl_Obj *pObj;
979       int i;
980       TestvfsBuffer *pBuffer;
981       char *zName;
982       if( objc!=3 && objc!=4 ){
983         Tcl_WrongNumArgs(interp, 2, objv, "FILE ?VALUE?");
984         return TCL_ERROR;
985       }
986       zName = ckalloc(p->pParent->mxPathname);
987       p->pParent->xFullPathname(
988           p->pParent, Tcl_GetString(objv[2]),
989           p->pParent->mxPathname, zName
990       );
991       for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
992         if( 0==strcmp(pBuffer->zFile, zName) ) break;
993       }
994       ckfree(zName);
995       if( !pBuffer ){
996         Tcl_AppendResult(interp, "no such file: ", Tcl_GetString(objv[2]), 0);
997         return TCL_ERROR;
998       }
999       if( objc==4 ){
1000         int n;
1001         u8 *a = Tcl_GetByteArrayFromObj(objv[3], &n);
1002         int pgsz = pBuffer->pgsz;
1003         if( pgsz==0 ) pgsz = 65536;
1004         for(i=0; i*pgsz<n; i++){
1005           int nByte = pgsz;
1006           tvfsAllocPage(pBuffer, i, pgsz);
1007           if( n-i*pgsz<pgsz ){
1008             nByte = n;
1009           }
1010           memcpy(pBuffer->aPage[i], &a[i*pgsz], nByte);
1011         }
1012       }
1013 
1014       pObj = Tcl_NewObj();
1015       for(i=0; pBuffer->aPage[i]; i++){
1016         int pgsz = pBuffer->pgsz;
1017         if( pgsz==0 ) pgsz = 65536;
1018         Tcl_AppendObjToObj(pObj, Tcl_NewByteArrayObj(pBuffer->aPage[i], pgsz));
1019       }
1020       Tcl_SetObjResult(interp, pObj);
1021       break;
1022     }
1023 
1024     case CMD_FILTER: {
1025       static struct VfsMethod {
1026         char *zName;
1027         int mask;
1028       } vfsmethod [] = {
1029         { "xShmOpen",    TESTVFS_SHMOPEN_MASK },
1030         { "xShmLock",    TESTVFS_SHMLOCK_MASK },
1031         { "xShmBarrier", TESTVFS_SHMBARRIER_MASK },
1032         { "xShmUnmap",   TESTVFS_SHMCLOSE_MASK },
1033         { "xShmMap",     TESTVFS_SHMMAP_MASK },
1034         { "xSync",       TESTVFS_SYNC_MASK },
1035         { "xDelete",     TESTVFS_DELETE_MASK },
1036         { "xWrite",      TESTVFS_WRITE_MASK },
1037         { "xTruncate",   TESTVFS_TRUNCATE_MASK },
1038         { "xOpen",       TESTVFS_OPEN_MASK },
1039         { "xClose",      TESTVFS_CLOSE_MASK },
1040         { "xAccess",     TESTVFS_ACCESS_MASK },
1041       };
1042       Tcl_Obj **apElem = 0;
1043       int nElem = 0;
1044       int i;
1045       int mask = 0;
1046       if( objc!=3 ){
1047         Tcl_WrongNumArgs(interp, 2, objv, "LIST");
1048         return TCL_ERROR;
1049       }
1050       if( Tcl_ListObjGetElements(interp, objv[2], &nElem, &apElem) ){
1051         return TCL_ERROR;
1052       }
1053       Tcl_ResetResult(interp);
1054       for(i=0; i<nElem; i++){
1055         int iMethod;
1056         char *zElem = Tcl_GetString(apElem[i]);
1057         for(iMethod=0; iMethod<ArraySize(vfsmethod); iMethod++){
1058           if( strcmp(zElem, vfsmethod[iMethod].zName)==0 ){
1059             mask |= vfsmethod[iMethod].mask;
1060             break;
1061           }
1062         }
1063         if( iMethod==ArraySize(vfsmethod) ){
1064           Tcl_AppendResult(interp, "unknown method: ", zElem, 0);
1065           return TCL_ERROR;
1066         }
1067       }
1068       p->mask = mask;
1069       break;
1070     }
1071 
1072     case CMD_SCRIPT: {
1073       if( objc==3 ){
1074         int nByte;
1075         if( p->pScript ){
1076           Tcl_DecrRefCount(p->pScript);
1077           ckfree((char *)p->apScript);
1078           p->apScript = 0;
1079           p->nScript = 0;
1080           p->pScript = 0;
1081         }
1082         Tcl_GetStringFromObj(objv[2], &nByte);
1083         if( nByte>0 ){
1084           p->pScript = Tcl_DuplicateObj(objv[2]);
1085           Tcl_IncrRefCount(p->pScript);
1086         }
1087       }else if( objc!=2 ){
1088         Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
1089         return TCL_ERROR;
1090       }
1091 
1092       Tcl_ResetResult(interp);
1093       if( p->pScript ) Tcl_SetObjResult(interp, p->pScript);
1094 
1095       break;
1096     }
1097 
1098     /*
1099     ** TESTVFS ioerr ?IFAIL PERSIST?
1100     **
1101     **   Where IFAIL is an integer and PERSIST is boolean.
1102     */
1103     case CMD_CANTOPENERR:
1104     case CMD_IOERR:
1105     case CMD_FULLERR: {
1106       TestFaultInject *pTest;
1107       int iRet;
1108 
1109       switch( aSubcmd[i].eCmd ){
1110         case CMD_IOERR: pTest = &p->ioerr_err; break;
1111         case CMD_FULLERR: pTest = &p->full_err; break;
1112         case CMD_CANTOPENERR: pTest = &p->cantopen_err; break;
1113         default: assert(0);
1114       }
1115       iRet = pTest->nFail;
1116       pTest->nFail = 0;
1117       pTest->eFault = 0;
1118       pTest->iCnt = 0;
1119 
1120       if( objc==4 ){
1121         int iCnt, iPersist;
1122         if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &iCnt)
1123          || TCL_OK!=Tcl_GetBooleanFromObj(interp, objv[3], &iPersist)
1124         ){
1125           return TCL_ERROR;
1126         }
1127         pTest->eFault = iPersist?FAULT_INJECT_PERSISTENT:FAULT_INJECT_TRANSIENT;
1128         pTest->iCnt = iCnt;
1129       }else if( objc!=2 ){
1130         Tcl_WrongNumArgs(interp, 2, objv, "?CNT PERSIST?");
1131         return TCL_ERROR;
1132       }
1133       Tcl_SetObjResult(interp, Tcl_NewIntObj(iRet));
1134       break;
1135     }
1136 
1137     case CMD_DELETE: {
1138       Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
1139       break;
1140     }
1141 
1142     case CMD_DEVCHAR: {
1143       struct DeviceFlag {
1144         char *zName;
1145         int iValue;
1146       } aFlag[] = {
1147         { "default",               -1 },
1148         { "atomic",                SQLITE_IOCAP_ATOMIC      },
1149         { "atomic512",             SQLITE_IOCAP_ATOMIC512   },
1150         { "atomic1k",              SQLITE_IOCAP_ATOMIC1K    },
1151         { "atomic2k",              SQLITE_IOCAP_ATOMIC2K    },
1152         { "atomic4k",              SQLITE_IOCAP_ATOMIC4K    },
1153         { "atomic8k",              SQLITE_IOCAP_ATOMIC8K    },
1154         { "atomic16k",             SQLITE_IOCAP_ATOMIC16K   },
1155         { "atomic32k",             SQLITE_IOCAP_ATOMIC32K   },
1156         { "atomic64k",             SQLITE_IOCAP_ATOMIC64K   },
1157         { "sequential",            SQLITE_IOCAP_SEQUENTIAL  },
1158         { "safe_append",           SQLITE_IOCAP_SAFE_APPEND },
1159         { "undeletable_when_open", SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN },
1160         { 0, 0 }
1161       };
1162       Tcl_Obj *pRet;
1163       int iFlag;
1164 
1165       if( objc>3 ){
1166         Tcl_WrongNumArgs(interp, 2, objv, "?ATTR-LIST?");
1167         return TCL_ERROR;
1168       }
1169       if( objc==3 ){
1170         int j;
1171         int iNew = 0;
1172         Tcl_Obj **flags = 0;
1173         int nFlags = 0;
1174 
1175         if( Tcl_ListObjGetElements(interp, objv[2], &nFlags, &flags) ){
1176           return TCL_ERROR;
1177         }
1178 
1179         for(j=0; j<nFlags; j++){
1180           int idx = 0;
1181           if( Tcl_GetIndexFromObjStruct(interp, flags[j], aFlag,
1182                 sizeof(aFlag[0]), "flag", 0, &idx)
1183           ){
1184             return TCL_ERROR;
1185           }
1186           if( aFlag[idx].iValue<0 && nFlags>1 ){
1187             Tcl_AppendResult(interp, "bad flags: ", Tcl_GetString(objv[2]), 0);
1188             return TCL_ERROR;
1189           }
1190           iNew |= aFlag[idx].iValue;
1191         }
1192 
1193         p->iDevchar = iNew;
1194       }
1195 
1196       pRet = Tcl_NewObj();
1197       for(iFlag=0; iFlag<sizeof(aFlag)/sizeof(aFlag[0]); iFlag++){
1198         if( p->iDevchar & aFlag[iFlag].iValue ){
1199           Tcl_ListObjAppendElement(
1200               interp, pRet, Tcl_NewStringObj(aFlag[iFlag].zName, -1)
1201           );
1202         }
1203       }
1204       Tcl_SetObjResult(interp, pRet);
1205 
1206       break;
1207     }
1208 
1209     case CMD_SECTORSIZE: {
1210       if( objc>3 ){
1211         Tcl_WrongNumArgs(interp, 2, objv, "?VALUE?");
1212         return TCL_ERROR;
1213       }
1214       if( objc==3 ){
1215         int iNew = 0;
1216         if( Tcl_GetIntFromObj(interp, objv[2], &iNew) ){
1217           return TCL_ERROR;
1218         }
1219         p->iSectorsize = iNew;
1220       }
1221       Tcl_SetObjResult(interp, Tcl_NewIntObj(p->iSectorsize));
1222       break;
1223     }
1224   }
1225 
1226   return TCL_OK;
1227 }
1228 
1229 static void testvfs_obj_del(ClientData cd){
1230   Testvfs *p = (Testvfs *)cd;
1231   if( p->pScript ) Tcl_DecrRefCount(p->pScript);
1232   sqlite3_vfs_unregister(p->pVfs);
1233   ckfree((char *)p->apScript);
1234   ckfree((char *)p->pVfs);
1235   ckfree((char *)p);
1236 }
1237 
1238 /*
1239 ** Usage:  testvfs VFSNAME ?SWITCHES?
1240 **
1241 ** Switches are:
1242 **
1243 **   -noshm   BOOLEAN             (True to omit shm methods. Default false)
1244 **   -default BOOLEAN             (True to make the vfs default. Default false)
1245 **
1246 ** This command creates two things when it is invoked: an SQLite VFS, and
1247 ** a Tcl command. Both are named VFSNAME. The VFS is installed. It is not
1248 ** installed as the default VFS.
1249 **
1250 ** The VFS passes all file I/O calls through to the underlying VFS.
1251 **
1252 ** Whenever the xShmMap method of the VFS
1253 ** is invoked, the SCRIPT is executed as follows:
1254 **
1255 **   SCRIPT xShmMap    FILENAME ID
1256 **
1257 ** The value returned by the invocation of SCRIPT above is interpreted as
1258 ** an SQLite error code and returned to SQLite. Either a symbolic
1259 ** "SQLITE_OK" or numeric "0" value may be returned.
1260 **
1261 ** The contents of the shared-memory buffer associated with a given file
1262 ** may be read and set using the following command:
1263 **
1264 **   VFSNAME shm FILENAME ?NEWVALUE?
1265 **
1266 ** When the xShmLock method is invoked by SQLite, the following script is
1267 ** run:
1268 **
1269 **   SCRIPT xShmLock    FILENAME ID LOCK
1270 **
1271 ** where LOCK is of the form "OFFSET NBYTE lock/unlock shared/exclusive"
1272 */
1273 static int testvfs_cmd(
1274   ClientData cd,
1275   Tcl_Interp *interp,
1276   int objc,
1277   Tcl_Obj *CONST objv[]
1278 ){
1279   static sqlite3_vfs tvfs_vfs = {
1280     2,                            /* iVersion */
1281     0,                            /* szOsFile */
1282     0,                            /* mxPathname */
1283     0,                            /* pNext */
1284     0,                            /* zName */
1285     0,                            /* pAppData */
1286     tvfsOpen,                     /* xOpen */
1287     tvfsDelete,                   /* xDelete */
1288     tvfsAccess,                   /* xAccess */
1289     tvfsFullPathname,             /* xFullPathname */
1290 #ifndef SQLITE_OMIT_LOAD_EXTENSION
1291     tvfsDlOpen,                   /* xDlOpen */
1292     tvfsDlError,                  /* xDlError */
1293     tvfsDlSym,                    /* xDlSym */
1294     tvfsDlClose,                  /* xDlClose */
1295 #else
1296     0,                            /* xDlOpen */
1297     0,                            /* xDlError */
1298     0,                            /* xDlSym */
1299     0,                            /* xDlClose */
1300 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
1301     tvfsRandomness,               /* xRandomness */
1302     tvfsSleep,                    /* xSleep */
1303     tvfsCurrentTime,              /* xCurrentTime */
1304     0,                            /* xGetLastError */
1305     0,                            /* xCurrentTimeInt64 */
1306   };
1307 
1308   Testvfs *p;                     /* New object */
1309   sqlite3_vfs *pVfs;              /* New VFS */
1310   char *zVfs;
1311   int nByte;                      /* Bytes of space to allocate at p */
1312 
1313   int i;
1314   int isNoshm = 0;                /* True if -noshm is passed */
1315   int isDefault = 0;              /* True if -default is passed */
1316   int szOsFile = 0;               /* Value passed to -szosfile */
1317   int mxPathname = -1;            /* Value passed to -mxpathname */
1318   int iVersion = 2;               /* Value passed to -iversion */
1319 
1320   if( objc<2 || 0!=(objc%2) ) goto bad_args;
1321   for(i=2; i<objc; i += 2){
1322     int nSwitch;
1323     char *zSwitch;
1324     zSwitch = Tcl_GetStringFromObj(objv[i], &nSwitch);
1325 
1326     if( nSwitch>2 && 0==strncmp("-noshm", zSwitch, nSwitch) ){
1327       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isNoshm) ){
1328         return TCL_ERROR;
1329       }
1330     }
1331     else if( nSwitch>2 && 0==strncmp("-default", zSwitch, nSwitch) ){
1332       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isDefault) ){
1333         return TCL_ERROR;
1334       }
1335     }
1336     else if( nSwitch>2 && 0==strncmp("-szosfile", zSwitch, nSwitch) ){
1337       if( Tcl_GetIntFromObj(interp, objv[i+1], &szOsFile) ){
1338         return TCL_ERROR;
1339       }
1340     }
1341     else if( nSwitch>2 && 0==strncmp("-mxpathname", zSwitch, nSwitch) ){
1342       if( Tcl_GetIntFromObj(interp, objv[i+1], &mxPathname) ){
1343         return TCL_ERROR;
1344       }
1345     }
1346     else if( nSwitch>2 && 0==strncmp("-iversion", zSwitch, nSwitch) ){
1347       if( Tcl_GetIntFromObj(interp, objv[i+1], &iVersion) ){
1348         return TCL_ERROR;
1349       }
1350     }
1351     else{
1352       goto bad_args;
1353     }
1354   }
1355 
1356   if( szOsFile<sizeof(TestvfsFile) ){
1357     szOsFile = sizeof(TestvfsFile);
1358   }
1359 
1360   zVfs = Tcl_GetString(objv[1]);
1361   nByte = sizeof(Testvfs) + strlen(zVfs)+1;
1362   p = (Testvfs *)ckalloc(nByte);
1363   memset(p, 0, nByte);
1364   p->iDevchar = -1;
1365   p->iSectorsize = -1;
1366 
1367   /* Create the new object command before querying SQLite for a default VFS
1368   ** to use for 'real' IO operations. This is because creating the new VFS
1369   ** may delete an existing [testvfs] VFS of the same name. If such a VFS
1370   ** is currently the default, the new [testvfs] may end up calling the
1371   ** methods of a deleted object.
1372   */
1373   Tcl_CreateObjCommand(interp, zVfs, testvfs_obj_cmd, p, testvfs_obj_del);
1374   p->pParent = sqlite3_vfs_find(0);
1375   p->interp = interp;
1376 
1377   p->zName = (char *)&p[1];
1378   memcpy(p->zName, zVfs, strlen(zVfs)+1);
1379 
1380   pVfs = (sqlite3_vfs *)ckalloc(sizeof(sqlite3_vfs));
1381   memcpy(pVfs, &tvfs_vfs, sizeof(sqlite3_vfs));
1382   pVfs->pAppData = (void *)p;
1383   pVfs->iVersion = iVersion;
1384   pVfs->zName = p->zName;
1385   pVfs->mxPathname = p->pParent->mxPathname;
1386   if( mxPathname>=0 && mxPathname<pVfs->mxPathname ){
1387     pVfs->mxPathname = mxPathname;
1388   }
1389   pVfs->szOsFile = szOsFile;
1390   p->pVfs = pVfs;
1391   p->isNoshm = isNoshm;
1392   p->mask = TESTVFS_ALL_MASK;
1393 
1394   sqlite3_vfs_register(pVfs, isDefault);
1395 
1396   return TCL_OK;
1397 
1398  bad_args:
1399   Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
1400   return TCL_ERROR;
1401 }
1402 
1403 int Sqlitetestvfs_Init(Tcl_Interp *interp){
1404   Tcl_CreateObjCommand(interp, "testvfs", testvfs_cmd, 0, 0);
1405   return TCL_OK;
1406 }
1407 
1408 #endif
1409