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