ifeq (clang,$(compiler))
  BCC ?= clang -g -Wall
endif

########################################################################
# optionally set OPTS to various sqlite4 build options.
# OPTS = -DHI_WORLD
# OPTS += -DLSM_DEBUG_MEM=1

########################################################################
# Now include the main rules...
include Makefile.linux-gcc
########################################################################
# Force regeneration of sqlite4.h if any makefiles change...
parse.h sqlite4.h: $(MAKEFILE_LIST)

  $(TOP)/test/test_utf.c \
  $(TOP)/test/test_misc1.c \
  $(TOP)/test/test_config.c \
  $(TOP)/test/test_func.c \
  $(TOP)/test/test_hexio.c \
  $(TOP)/test/test_lsm.c \
  $(TOP)/test/test_malloc.c \
  $(TOP)/test/test_mem.c \
  $(TOP)/test/test_mutex.c \
  $(TOP)/test/test_storage.c \
  $(TOP)/test/test_storage2.c \
  $(TOP)/test/test_thread.c \
  $(TOP)/test/test_wsd.c

#TESTSRC += $(TOP)/ext/fts2/fts2_tokenizer.c

	rm -f $(PUBLISH)
	rm -f *.da *.bb *.bbg gmon.out
	rm -rf tsrc target_source
	rm -f testloadext.dll libtestloadext.so
	rm -f amalgamation-testfixture amalgamation-testfixture.exe
	rm -f fts3-testfixture fts3-testfixture.exe
	rm -f testfixture testfixture.exe
	rm -f lsmtest
	rm -f threadtest3 threadtest3.exe
	rm -f sqlite4.c fts?amal.c tclsqlite4.c
	rm -f sqlite4_analyzer sqlite4_analyzer.exe sqlite4_analyzer.c

default:
	$(MAKE) -C .. all testfixture
$(MAKECMDGOALS):
	$(MAKE) -C .. $@

*************************************************************************
**
** This file defines the LSM API.
*/
#ifndef _LSM_H
#define _LSM_H
#include <stddef.h>
#include "sqlite4.h" /* for sqlite4_size_t */
#ifdef __cplusplus
extern "C" {
#endif

/*
** Opaque handle types.
*/

  int (*xClose)(lsm_file *);
  int (*xUnlink)(lsm_env*, const char *);
  /****** memory allocation ****************************************/
  void *pMemCtx;
  void *(*xMalloc)(lsm_env*, int);            /* malloc(3) function */
  void *(*xRealloc)(lsm_env*, void *, int);   /* realloc(3) function */
  void (*xFree)(lsm_env*, void *);            /* free(3) function */
#if 1
  sqlite4_size_t (*xSize)(lsm_env*, void *);  /* xSize function */
#endif
  /****** mutexes ****************************************************/
  void *pMutexCtx;
  int (*xMutexStatic)(lsm_env*,int,lsm_mutex**); /* Obtain a static mutex */
  int (*xMutexNew)(lsm_env*, lsm_mutex**);       /* Get a new dynamic mutex */
  void (*xMutexDel)(lsm_mutex *);           /* Delete an allocated mutex */
  void (*xMutexEnter)(lsm_mutex *);         /* Grab a mutex */
  int (*xMutexTry)(lsm_mutex *);            /* Attempt to obtain a mutex */

** must be held in order to call this function.
**
** If successful, *piBlk is set to the block number allocated and LSM_OK is
** returned. Otherwise, *piBlk is zeroed and an lsm error code returned.
*/
int lsmBlockAllocate(lsm_db *pDb, int *piBlk){
  Database *p = pDb->pDatabase;

  Freelist *pFree;                /* Database free list */
  int iRet = 0;                   /* Block number of allocated block */
 

  pFree = &p->freelist;

  if( pFree->nEntry>0 ){
    /* The first block on the free list was freed as part of the work done
    ** to create the snapshot with id iFree. So, we can reuse this block if
    ** snapshot iFree or later has been checkpointed and all currently 
    ** active clients are reading from snapshot iFree or later.

  int prc = unlink(zFile);
  return prc ? LSM_IOERR_BKPT : LSM_OK;
}

/****************************************************************************
** Memory allocation routines.
*/
#define ROUND8(x) (((x)+7)&~7)
#define BLOCK_HDR_SIZE ROUND8( sizeof(sqlite4_size_t) )

static void *lsmPosixOsMalloc(lsm_env *pEnv, int N){
  unsigned char * m;
  N += BLOCK_HDR_SIZE;
  m = (unsigned char *)malloc(N);
  *((sqlite4_size_t*)m) = N;
  return m + BLOCK_HDR_SIZE;
}

static void lsmPosixOsFree(lsm_env *pEnv, void *p){
  if(p){
    free( ((unsigned char *)p) - BLOCK_HDR_SIZE );
  }
}

static void *lsmPosixOsRealloc(lsm_env *pEnv, void *p, int N){
  unsigned char * m = (unsigned char *)p;
  if(1>N){
    lsmPosixOsFree( pEnv, p );
    return NULL;
  }else if(NULL==p){
    return lsmPosixOsMalloc(pEnv, N);
  }else{
    void * re = NULL;
    m -= BLOCK_HDR_SIZE;
#if 0 /* arguable: don't shrink */
    sqlite4_size_t * sz = (sqlite4_size_t*)m;
    if(*sz >= (sqlite4_size_t)N){
      return p;
    }
#endif
    re = realloc( m, N + BLOCK_HDR_SIZE );
    if(re){
      m = (unsigned char *)re;
      *((sqlite4_size_t*)m) = N;
      return m + BLOCK_HDR_SIZE;
    }else{
      return NULL;
    }
  }
}

static sqlite4_size_t lsmPosixOsMSize(lsm_env *pEnv, void *p){
  unsigned char * m = (unsigned char *)p;
  return *((sqlite4_size_t*)(m-BLOCK_HDR_SIZE));
}
#undef ROUND8
#undef BLOCK_HDR_SIZE


#ifdef LSM_MUTEX_PTHREADS 
/*************************************************************************
** Mutex methods for pthreads based systems.  If LSM_MUTEX_PTHREADS is
** missing then a no-op implementation of mutexes found in lsm_mutex.c
** will be used instead.

    lsmPosixOsClose,         /* xClose */
    lsmPosixOsUnlink,        /* xUnlink */
    /***** memory allocation *********/
    0,                       /* pMemCtx */
    lsmPosixOsMalloc,        /* xMalloc */
    lsmPosixOsRealloc,       /* xRealloc */
    lsmPosixOsFree,          /* xFree */
    lsmPosixOsMSize,         /* xSize */
    /***** mutexes *********************/
    0,                       /* pMutexCtx */
    lsmPosixOsMutexStatic,   /* xMutexStatic */
    lsmPosixOsMutexNew,      /* xMutexNew */
    lsmPosixOsMutexDel,      /* xMutexDel */
    lsmPosixOsMutexEnter,    /* xMutexEnter */
    lsmPosixOsMutexTry,      /* xMutexTry */
    lsmPosixOsMutexLeave,    /* xMutexLeave */
    lsmPosixOsMutexHeld,     /* xMutexHeld */
    lsmPosixOsMutexNotHeld,  /* xMutexNotHeld */
  };
  return &posix_env;
}

# include "sqlite4.h"
# include <stdlib.h>
# include <string.h>
# include <assert.h>
  typedef unsigned char u8;
#endif
#include <ctype.h>
#include <stdlib.h> /* atexit() */
/*
 * Windows needs to know which symbols to export.  Unix does not.
 * BUILD_sqlite should be undefined for Unix.
 */
#ifdef BUILD_sqlite
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

  if( !slave ){
    return TCL_ERROR;
  }

  init_all(slave);
  return TCL_OK;
}


/*
** Tclcmd: db_use_legacy_prepare DB BOOLEAN
**
**   The first argument to this command must be a database command created by
**   [sqlite4]. If the second argument is true, then the handle is configured
**   to use the sqlite4_prepare_v2() function to prepare statements. If it

    extern int Sqlitetestrtree_Init(Tcl_Interp*);
    extern int Sqlitequota_Init(Tcl_Interp*);
    extern int SqliteSuperlock_Init(Tcl_Interp*);
    extern int SqlitetestSyscall_Init(Tcl_Interp*);
    extern int Sqliteteststorage_Init(Tcl_Interp*);
    extern int Sqliteteststorage2_Init(Tcl_Interp*);
    extern int SqlitetestLsm_Init(Tcl_Interp*);
    extern int Sqlitetest_mem_Init(Tcl_Interp*);

    Sqliteconfig_Init(interp);
    Sqlitetest1_Init(interp);
    Sqlitetest4_Init(interp);
    Sqlitetest5_Init(interp);
    Sqlitetest9_Init(interp);
    Sqlitetest_hexio_Init(interp);
    Sqlitetest_malloc_Init(interp);
    Sqlitetest_mutex_Init(interp);
    SqlitetestThread_Init(interp);
    Sqliteteststorage_Init(interp);
    Sqliteteststorage2_Init(interp);
    SqlitetestLsm_Init(interp);
    Sqlitetest_mem_Init(interp);


    Tcl_CreateObjCommand(
        interp, "load_testfixture_extensions", init_all_cmd, 0, 0
    );
    Tcl_CreateObjCommand(
        interp, "db_use_legacy_prepare", db_use_legacy_prepare_cmd, 0, 0

  Tcl_Interp *interp;
  
  /* Call sqlite4_shutdown() once before doing anything else. This is to
  ** test that sqlite4_shutdown() can be safely called by a process before
  ** sqlite4_initialize() is. */
  sqlite4_shutdown(0);

  /*Tcl_FindExecutable(argv[0]);*/
  interp = Tcl_CreateInterp();

#if TCLSH==2
  sqlite4_env_config(0, SQLITE4_ENVCONFIG_SINGLETHREAD);
#endif

  init_all(interp);
  if( argc>=2 ){
    int i;
    char zArgc[32];
    sqlite4_snprintf(zArgc, sizeof(zArgc), "%d", argc-(3-TCLSH));
    Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
    for(i=3-TCLSH; i<argc; i++){
      Tcl_SetVar(interp, "argv", argv[i],
          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
    }
    if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
      if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
      fprintf(stderr,"%s: %s\n", *argv, zInfo);
      Tcl_DeleteInterp( interp );
      return 1;
    }
  }
  if( TCLSH==2 || argc<=1 ){
    Tcl_GlobalEval(interp, tclsh_main_loop());
  }
  Tcl_DeleteInterp( interp );
  return 0;
}
#endif /* TCLSH */

#define StmtToDb(X)   sqlite4_db_handle(X)

/*
** Check a return value to make sure it agrees with the results
** from sqlite4_errcode.
*/
int sqlite4TestErrCode(Tcl_Interp *interp, sqlite4 *db, int rc){

  if( rc!=SQLITE4_MISUSE && rc!=SQLITE4_OK && sqlite4_errcode(db)!=rc ){
    char zBuf[200];
    int r2 = sqlite4_errcode(db);
    sprintf(zBuf, "error code %s (%d) does not match sqlite4_errcode %s (%d)",
       t1ErrorName(rc), rc, t1ErrorName(r2), r2);
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, zBuf, 0);

/*
** 2012 July 7
**
** The author disclaims copyright to this source code.  In place of
** a legal notice, here is a blessing:
**
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*/
#include <stdio.h>
#include <assert.h>
#include <string.h>

#include "sqlite4.h"

#define ArraySize(x) ((int)(sizeof(x) / sizeof((x)[0])))

#define MIN(x,y) ((x)<(y) ? (x) : (y))

typedef unsigned int  u32;
typedef unsigned char u8;
typedef long long int i64;
typedef unsigned long long int u64;

#if defined(__GLIBC__)
  extern int backtrace(void**,int);
  extern void backtrace_symbols_fd(void*const*,int,int);
# define TM_BACKTRACE 12
#else
# define backtrace(A,B) 1
# define backtrace_symbols_fd(A,B,C)
#endif


typedef struct TmBlockHdr TmBlockHdr;
typedef struct TmAgg TmAgg;
typedef struct TmGlobal TmGlobal;

struct TmGlobal {
  /* Linked list of all currently outstanding allocations. And a table of
  ** all allocations, past and present, indexed by backtrace() info.  */
  TmBlockHdr *pFirst;
#ifdef TM_BACKTRACE
  TmAgg *aHash[10000];
#endif

  /* Underlying malloc/realloc/free functions */
  sqlite4_mem_methods mem;
};

struct TmBlockHdr {
  TmBlockHdr *pNext;
  TmBlockHdr *pPrev;
  int nByte;
#ifdef TM_BACKTRACE
  TmAgg *pAgg;
#endif
  u32 iForeGuard;
};

#ifdef TM_BACKTRACE
struct TmAgg {
  int nAlloc;                     /* Number of allocations at this path */
  int nByte;                      /* Total number of bytes allocated */
  int nOutAlloc;                  /* Number of outstanding allocations */
  int nOutByte;                   /* Number of outstanding bytes */
  void *aFrame[TM_BACKTRACE];     /* backtrace() output */
  TmAgg *pNext;                   /* Next object in hash-table collision */
};
#endif

#define FOREGUARD 0x80F5E153
#define REARGUARD 0xE4676B53
static const u32 rearguard = REARGUARD;

#define ROUND8(x) (((x)+7)&~7)
#define BLOCK_HDR_SIZE (ROUND8( sizeof(TmBlockHdr) ))

static void tmEnterMutex(TmGlobal *pTm){
  /*pTm->xEnterMutex(pTm);*/
}
static void tmLeaveMutex(TmGlobal *pTm){
  /* pTm->xLeaveMutex(pTm); */
}

static void *tmMalloc(TmGlobal *pTm, int nByte){
  TmBlockHdr *pNew;               /* New allocation header block */
  u8 *pUser;                      /* Return value */
  int nReq;                       /* Total number of bytes requested */

  assert( sizeof(rearguard)==4 );
  nReq = BLOCK_HDR_SIZE + nByte + 4;
  pNew = (TmBlockHdr *)pTm->mem.xMalloc(pTm->mem.pMemEnv, nReq);
  memset(pNew, 0, sizeof(TmBlockHdr));

  tmEnterMutex(pTm);

  pNew->iForeGuard = FOREGUARD;
  pNew->nByte = nByte;
  pNew->pNext = pTm->pFirst;

  if( pTm->pFirst ){
    pTm->pFirst->pPrev = pNew;
  }
  pTm->pFirst = pNew;

  pUser = &((u8 *)pNew)[BLOCK_HDR_SIZE];
  memset(pUser, 0x56, nByte);
  memcpy(&pUser[nByte], &rearguard, 4);

#ifdef TM_BACKTRACE
  {
    TmAgg *pAgg;
    int i;
    u32 iHash = 0;
    void *aFrame[TM_BACKTRACE];
    memset(aFrame, 0, sizeof(aFrame));
    backtrace(aFrame, TM_BACKTRACE);

    for(i=0; i<ArraySize(aFrame); i++){
      iHash += (u64)(aFrame[i]) + (iHash<<3);
    }
    iHash = iHash % ArraySize(pTm->aHash);

    for(pAgg=pTm->aHash[iHash]; pAgg; pAgg=pAgg->pNext){
      if( memcmp(pAgg->aFrame, aFrame, sizeof(aFrame))==0 ) break;
    }
    if( !pAgg ){
      pAgg = (TmAgg *)pTm->mem.xMalloc(pTm->mem.pMemEnv, sizeof(TmAgg));
      memset(pAgg, 0, sizeof(TmAgg));
      memcpy(pAgg->aFrame, aFrame, sizeof(aFrame));
      pAgg->pNext = pTm->aHash[iHash];
      pTm->aHash[iHash] = pAgg;
    }
    pAgg->nAlloc++;
    pAgg->nByte += nByte;
    pAgg->nOutAlloc++;
    pAgg->nOutByte += nByte;
    pNew->pAgg = pAgg;
  }
#endif

  tmLeaveMutex(pTm);
  return pUser;
}

static void tmFree(TmGlobal *pTm, void *p){
  if( p ){
    TmBlockHdr *pHdr;
    u8 *pUser = (u8 *)p;

    tmEnterMutex(pTm);
    pHdr = (TmBlockHdr *)&pUser[BLOCK_HDR_SIZE * -1];
    assert( pHdr->iForeGuard==FOREGUARD );
    assert( 0==memcmp(&pUser[pHdr->nByte], &rearguard, 4) );

    if( pHdr->pPrev ){
      assert( pHdr->pPrev->pNext==pHdr );
      pHdr->pPrev->pNext = pHdr->pNext;
    }else{
      assert( pHdr==pTm->pFirst );
      pTm->pFirst = pHdr->pNext;
    }
    if( pHdr->pNext ){
      assert( pHdr->pNext->pPrev==pHdr );
      pHdr->pNext->pPrev = pHdr->pPrev;
    }

#ifdef TM_BACKTRACE
    pHdr->pAgg->nOutAlloc--;
    pHdr->pAgg->nOutByte -= pHdr->nByte;
#endif

    tmLeaveMutex(pTm);
    memset(pUser, 0x58, pHdr->nByte);
    memset(pHdr, 0x57, sizeof(TmBlockHdr));
    pTm->mem.xFree(pTm->mem.pMemEnv, pHdr);
  }
}

static void *tmRealloc(TmGlobal *pTm, void *p, int nByte){
  void *pNew;

  pNew = tmMalloc(pTm, nByte);
  if( pNew && p ){
    TmBlockHdr *pHdr;
    u8 *pUser = (u8 *)p;
    pHdr = (TmBlockHdr *)&pUser[BLOCK_HDR_SIZE * -1];
    memcpy(pNew, p, MIN(nByte, pHdr->nByte));
    tmFree(pTm, p);
  }
  return pNew;
}

static void tmMallocCheck(
  TmGlobal *pTm,
  int *pnLeakAlloc,
  int *pnLeakByte,
  FILE *pFile
){
  TmBlockHdr *pHdr;
  int nLeak = 0;
  int nByte = 0;

  if( pTm==0 ) return;

  for(pHdr=pTm->pFirst; pHdr; pHdr=pHdr->pNext){
    nLeak++; 
    nByte += pHdr->nByte;
  }
  if( pnLeakAlloc ) *pnLeakAlloc = nLeak;
  if( pnLeakByte ) *pnLeakByte = nByte;

#ifdef TM_BACKTRACE
  if( pFile ){
    int i;
    fprintf(pFile, "LEAKS\n");
    for(i=0; i<ArraySize(pTm->aHash); i++){
      TmAgg *pAgg;
      for(pAgg=pTm->aHash[i]; pAgg; pAgg=pAgg->pNext){
        if( pAgg->nOutAlloc ){
          int j;
          fprintf(pFile, "%d %d ", pAgg->nOutByte, pAgg->nOutAlloc);
          for(j=0; j<TM_BACKTRACE; j++){
            fprintf(pFile, "%p ", pAgg->aFrame[j]);
          }
          fprintf(pFile, "\n");
        }
      }
    }
    fprintf(pFile, "\nALLOCATIONS\n");
    for(i=0; i<ArraySize(pTm->aHash); i++){
      TmAgg *pAgg;
      for(pAgg=pTm->aHash[i]; pAgg; pAgg=pAgg->pNext){
        int j;
        fprintf(pFile, "%d %d ", pAgg->nByte, pAgg->nAlloc);
        for(j=0; j<TM_BACKTRACE; j++) fprintf(pFile, "%p ", pAgg->aFrame[j]);
        fprintf(pFile, "\n");
      }
    }
  }
#else
  (void)pFile;
#endif
}


static void *tmLsmEnvXMalloc(void *p, sqlite4_size_t n){
  return tmMalloc( (TmGlobal*) p, (int)n );
}

static void tmLsmEnvXFree(void *p, void *ptr){ 
  tmFree( (TmGlobal *)p, ptr );
}

static void *tmLsmEnvXRealloc(void *ptr, void * mem, int n){
  return tmRealloc((TmGlobal*)ptr, mem, n);
}


static sqlite4_size_t tmLsmXSize(void *p, void *ptr){
  if(NULL==ptr){
    return 0;
  }else{
    unsigned char * pUc = (unsigned char *)ptr;
    TmBlockHdr * pBlock = (TmBlockHdr*)(pUc-BLOCK_HDR_SIZE);
    assert( pBlock->nByte > 0 );
    return (sqlite4_size_t) pBlock->nByte;
  }
}

static int tmInitStub(void* ignored){
  assert("Set breakpoint here.");
  return 0;
}
static void tmVoidStub(void* ignored){}


int testMallocInstall(sqlite4_env *pEnv){
  TmGlobal *pGlobal;              /* Object containing allocation hash */
  sqlite4_mem_methods allocator;  /* This malloc system */
  sqlite4_mem_methods orig;       /* Underlying malloc system */

  /* Allocate and populate a TmGlobal structure. sqlite4_malloc cannot be
  ** used to allocate the TmGlobal struct as this would cause the environment
  ** to move to "initialized" state and the SQLITE4_ENVCONFIG_MALLOC 
  ** to fail. */
  sqlite4_env_config(pEnv, SQLITE4_ENVCONFIG_GETMALLOC, &orig);
  pGlobal = (TmGlobal *)orig.xMalloc(orig.pMemEnv, sizeof(TmGlobal));
  memset(pGlobal, 0, sizeof(TmGlobal));
  memcpy(&pGlobal->mem, &orig, sizeof(orig));

  /* Set up pEnv to the use the new TmGlobal */
  allocator.xRealloc = tmLsmEnvXRealloc;
  allocator.xMalloc = tmLsmEnvXMalloc;
  allocator.xFree = tmLsmEnvXFree;
  allocator.xSize = tmLsmXSize;
  allocator.xInit = tmInitStub;
  allocator.xShutdown = tmVoidStub;
  allocator.xBeginBenign = tmVoidStub;
  allocator.xEndBenign = tmVoidStub;
  allocator.pMemEnv = pGlobal;
  return sqlite4_env_config(pEnv, SQLITE4_ENVCONFIG_MALLOC, &allocator);
}

int testMallocUninstall(sqlite4_env *pEnv){
  TmGlobal *pGlobal;              /* Object containing allocation hash */
  sqlite4_mem_methods allocator;  /* This malloc system */
  int rc;

  sqlite4_env_config(pEnv, SQLITE4_ENVCONFIG_GETMALLOC, &allocator);
  assert( allocator.xMalloc==tmLsmEnvXMalloc );
  pGlobal = (TmGlobal *)allocator.pMemEnv;

  rc = sqlite4_env_config(pEnv, SQLITE4_ENVCONFIG_MALLOC, &pGlobal->mem);
  if( rc==SQLITE4_OK ){
    sqlite4_free(pEnv, pGlobal);
  }
  return rc;
}

void testMallocCheck(
  sqlite4_env *pEnv,
  int *pnLeakAlloc,
  int *pnLeakByte,
  FILE *pFile
){
  TmGlobal *pGlobal;
  sqlite4_mem_methods allocator;  /* This malloc system */

  sqlite4_env_config(pEnv, SQLITE4_ENVCONFIG_GETMALLOC, &allocator);
  assert( allocator.xMalloc==tmLsmEnvXMalloc );
  pGlobal = (TmGlobal *)allocator.pMemEnv;

  tmMallocCheck(pGlobal, pnLeakAlloc, pnLeakByte, pFile);
}

#include <tcl.h>

/*
** testmem install
** testmem uninstall
** testmem report ?FILENAME?
*/
static int testmem_cmd(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  sqlite4_env *pEnv;              /* SQLite 4 environment to work with */
  int iOpt;
  const char *azSub[] = {"install", "uninstall", "report", 0};

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "sub-command");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], azSub, "sub-command", 0, &iOpt) ){
    return TCL_ERROR;
  }

  pEnv = sqlite4_env_default();
  switch( iOpt ){
    case 0: {
      int rc;
      if( objc!=2 ){
        Tcl_WrongNumArgs(interp, 2, objv, "");
        return TCL_ERROR;
      }
      rc = testMallocInstall(pEnv);
      if( rc!=SQLITE4_OK ){
        Tcl_AppendResult(interp, "Failed to install testmem wrapper", 0);
        return TCL_ERROR;
      }
      break;
    }

    case 1:
      if( objc!=2 ){
        Tcl_WrongNumArgs(interp, 2, objv, "");
        return TCL_ERROR;
      }
      testMallocUninstall(pEnv);
      break;

    case 2: {
      int nLeakAlloc = 0;
      int nLeakByte = 0;
      FILE *pReport = 0;
      Tcl_Obj *pRes;

      if( objc!=2 && objc!=3 ){
        Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
        return TCL_ERROR;
      }
      if( objc==3 ){
        const char *zFile = Tcl_GetString(objv[2]);
        pReport = fopen(zFile, "w");
        if( !pReport ){
          Tcl_AppendResult(interp, "Failed to open file: ", zFile, 0);
          return TCL_ERROR;
        }
      }

      testMallocCheck(pEnv, &nLeakAlloc, &nLeakByte, pReport);
      if( pReport ) fclose(pReport);

      pRes = Tcl_NewObj();
      Tcl_ListObjAppendElement(interp, pRes, Tcl_NewIntObj(nLeakAlloc));
      Tcl_ListObjAppendElement(interp, pRes, Tcl_NewIntObj(nLeakByte));
      Tcl_SetObjResult(interp, pRes);
      break;
    }
  }

  return TCL_OK;
}

int Sqlitetest_mem_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "testmem", testmem_cmd, 0, 0);
  return TCL_OK;
}

  # Parse any options specified in the $argv array. This script accepts the 
  # following options: 
  #
  #   --pause
  #   --soft-heap-limit=NN
  #   --maxerror=NN
  #   --malloctrace=N

  #   --binarylog=N
  #   --soak=N
  #   --file-retries=N
  #   --file-retry-delay=N
  #   --start=[$permutation:]$testfile
  #   --match=$pattern
  #
  set cmdlinearg(soft-heap-limit)    0
  set cmdlinearg(maxerror)        1000
  set cmdlinearg(malloctrace)        0

  set cmdlinearg(binarylog)          0
  set cmdlinearg(soak)               0
  set cmdlinearg(file-retries)       0
  set cmdlinearg(file-retry-delay)   0
  set cmdlinearg(start)             ""
  set cmdlinearg(match)             ""

        foreach {dummy cmdlinearg(soft-heap-limit)} [split $a =] break
      }
      {^-+maxerror=.+$} {
        foreach {dummy cmdlinearg(maxerror)} [split $a =] break
      }
      {^-+malloctrace=.+$} {
        foreach {dummy cmdlinearg(malloctrace)} [split $a =] break







      }
      {^-+binarylog=.+$} {
        foreach {dummy cmdlinearg(binarylog)} [split $a =] break
      }
      {^-+soak=.+$} {
        foreach {dummy cmdlinearg(soak)} [split $a =] break
        set ::G(issoak) $cmdlinearg(soak)

  }
  set argv $leftover

  # Install the malloc layer used to inject OOM errors. And the 'automatic'
  # extensions. This only needs to be done once for the process.
  #
  sqlite4_shutdown 
  # install_malloc_faultsim 1 
  if {$cmdlinearg(malloctrace)} { testmem install }
  kvwrap install
  sqlite4_initialize
  #autoinstall_test_functions

  # If the --binarylog option was specified, create the logging VFS. This
  # call installs the new VFS as the default for all SQLite connections.
  #
  if {$cmdlinearg(binarylog)} {
    vfslog new binarylog {} vfslog.bin
  }






}

# Create a test database
#
proc reset_db {} {
  catch {db close}
  forcedelete test.db

  show_memstats
  puts "Maximum memory usage: [sqlite4_memory_highwater 1] bytes"
  puts "Current memory usage: [sqlite4_memory_highwater] bytes"
  if {[info commands sqlite4_memdebug_malloc_count] ne ""} {
    puts "Number of malloc()  : [sqlite4_memdebug_malloc_count] calls"
  }
  if {$::cmdlinearg(malloctrace)} {
    puts "Writing malloc() report to malloc.txt..."



    testmem report malloc.txt





  }
  foreach f [glob -nocomplain test.db-*-journal] {
    forcedelete $f
  }
  foreach f [glob -nocomplain test.db-mj*] {
    forcedelete $f
  }

package require sqlite3
package require Tk

#############################################################################
# Code to set up scrollbars for widgets. This is generic, boring stuff.
#
namespace eval autoscroll {
  proc scrollable {widget path args} {
    ::ttk::frame $path
    set w  [$widget ${path}.widget {*}$args]
    set vs [::ttk::scrollbar ${path}.vs]
    set hs [::ttk::scrollbar ${path}.hs -orient horizontal]
    grid $w  -row 0 -column 0 -sticky nsew
  
    grid rowconfigure    $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1
  
    set grid [list grid $vs -row 0 -column 1 -sticky nsew]
    $w configure -yscrollcommand [list ::autoscroll::scrollcommand $grid $vs]
    $vs configure -command       [list $w yview]
    set grid [list grid $hs -row 1 -column 0 -sticky nsew]
    $w configure -xscrollcommand [list ::autoscroll::scrollcommand $grid $hs]
    $hs configure -command       [list $w xview]
  
    return $w
  }
  proc scrollcommand {grid sb args} {
    $sb set {*}$args
    set isRequired [expr {[lindex $args 0] != 0.0 || [lindex $args 1] != 1.0}]
    if {$isRequired && ![winfo ismapped $sb]} {
      {*}$grid
    }
    if {!$isRequired && [winfo ismapped $sb]} {
      grid forget $sb
    }
  }
  namespace export scrollable
}
namespace import ::autoscroll::*
#############################################################################

proc populate_text_widget {db} {
  $::O(text) configure -state normal
  set id [lindex [$::O(tree) selection] 0]
  set frame [lindex $id end]

  set line [$db one {SELECT line FROM frame WHERE frame = $frame}]
  if {$line ne ""} {
    foreach {file line} [split $line :] {}
    set content [$db one "SELECT content FROM file WHERE name = '$file'"]
    $::O(text) delete 0.0 end

    set iLine 1
    foreach L [split $content "\n"] {
      if {$iLine == $line} {
        $::O(text) insert end "$L\n" highlight
      } else {
        $::O(text) insert end "$L\n"
      }
      incr iLine
    }
    $::O(text) yview -pickplace ${line}.0
  }
  $::O(text) configure -state disabled
}

proc populate_index {db} {
  $::O(text) configure -state normal
  
  $::O(text) delete 0.0 end
  $::O(text) insert end "\n\n"

  set L [format "    % -40s%12s%12s\n" "Test Case" "Allocations" "Bytes"]
  $::O(text) insert end $L
  $::O(text) insert end "    [string repeat - 64]\n"

  $db eval {
    -- SELECT 'TOTAL' AS ztest, sum(ncall) AS calls, sum(nbyte) AS bytes
    -- FROM malloc 
    -- UNION ALL

    SELECT ztest AS ztest, sum(ncall) AS calls, sum(nbyte) AS bytes
    FROM malloc 
    GROUP BY ztest

    ORDER BY 3 DESC
  } {
    set tags [list $ztest]
    if {$ztest eq $::O(current)} {
      lappend tags highlight
    }
    set L [format "    % -40s%12s%12s\n" $ztest $calls $bytes]
    $::O(text) insert end $L $tags

    $::O(text) tag bind $ztest <1> [list populate_tree_widget $db $ztest]
    $::O(text) tag bind $ztest <Enter> [list $::O(text) configure -cursor hand2]
    $::O(text) tag bind $ztest <Leave> [list $::O(text) configure -cursor ""]
  }

  $::O(text) configure -state disabled
}

proc sort_tree_compare {iLeft iRight} {
  global O
  switch -- [expr (int($O(tree_sort)/2))] {
    0 {
      set left  [$O(tree) item $iLeft -text]
      set right [$O(tree) item $iRight -text]
      set res [string compare $left $right]
    }
    1 {
      set left  [lindex [$O(tree) item $iLeft -values] 0]
      set right [lindex [$O(tree) item $iRight -values] 0]
      set res [expr $left - $right]
    }
    2 {
      set left  [lindex [$O(tree) item $iLeft -values] 1]
      set right [lindex [$O(tree) item $iRight -values] 1]
      set res [expr $left - $right]
    }
  }
  if {$O(tree_sort)&0x01} {
    set res [expr -1 * $res]
  }
  return $res
}

proc sort_tree {iMode} {
  global O
  if {$O(tree_sort) == $iMode} {
    incr O(tree_sort)
  } else {
    set O(tree_sort) $iMode
  }
  set T $O(tree)
  set items [$T children {}]
  set items [lsort -command sort_tree_compare $items]
  for {set ii 0} {$ii < [llength $items]} {incr ii} {
    $T move [lindex $items $ii] {} $ii
  }
}

proc trim_frames {stack} {
  while {[info exists ::O(ignore.[lindex $stack 0])]} {
    set stack [lrange $stack 1 end]
  }
  return $stack
}

proc populate_tree_widget {db zTest} {
  $::O(tree) delete [$::O(tree) children {}]

  for {set ii 0} {$ii < 15} {incr ii} {
    $db eval {
      SELECT 
        sum(ncall) AS calls, 
        sum(nbyte) AS bytes,
        trim_frames(lrange(lstack, 0, $ii)) AS stack
      FROM malloc
      WHERE (zTest = $zTest OR $zTest = 'TOTAL') AND llength(lstack)>$ii
      GROUP BY stack
      HAVING stack != ''
    } {
      set parent_id [lrange $stack 0 end-1]
      set frame [lindex $stack end]
      set line [$db one {SELECT line FROM frame WHERE frame = $frame}]
      set line [lindex [split $line /] end]
      set v [list $calls $bytes]

      catch {
        $::O(tree) insert $parent_id end -id $stack -text $line -values $v
      }
    }
  }

  set ::O(current) $zTest
  populate_index $db
}



set O(tree_sort) 0

::ttk::panedwindow .pan -orient horizontal
set O(tree) [scrollable ::ttk::treeview .pan.tree]

frame .pan.right
set O(text) [scrollable text .pan.right.text]
button .pan.right.index -command {populate_index mddb} -text "Show Index"
pack .pan.right.index -side top -fill x
pack .pan.right.text -fill both -expand true

$O(text) tag configure highlight -background wheat
$O(text) configure -wrap none -height 35

.pan add .pan.tree
.pan add .pan.right

$O(tree) configure     -columns {calls bytes}
$O(tree) heading #0    -text Line  -anchor w -command {sort_tree 0}
$O(tree) heading calls -text Calls -anchor w -command {sort_tree 2}
$O(tree) heading bytes -text Bytes -anchor w -command {sort_tree 4}
$O(tree) column #0    -width 150
$O(tree) column calls -width 100
$O(tree) column bytes -width 100

pack .pan -fill both -expand 1

#--------------------------------------------------------------------
# Open the database containing the malloc data. The user specifies the
# database to use by passing the file-name on the command line.
#

proc lsmtest_report_read {zReport} {
  sqlite3 mddb :memory:
  mddb eval {
    PRAGMA journal_mode=OFF;
    CREATE TABLE malloc(zTest, nCall, nByte, lStack);
    CREATE TABLE frame(frame PRIMARY KEY, function, line);
    CREATE TABLE file(name PRIMARY KEY, content);
  }

  set fd [open $zReport]
  set data [read $fd]
  close $fd

  set topic ""
  foreach zLine [split $data "\n"] {
    set list [split $zLine " "]
    if {[string is integer [lindex $list 0]]} {
      set nByte [lindex $list 0]
      set nCall [lindex $list 1]
      set lStack [lrange $list 2 end]
      mddb eval { INSERT INTO malloc VALUES($topic, $nCall, $nByte, $lStack) }
      foreach f $lStack { set aFrame($f) "" }
    } else {
      set topic [lindex $list 0]
    }
  }

  foreach k [array names aFrame] {
    set res [exec addr2line -f -e ./testfixture $k]

    set function [lindex $res 0] 
    set addr     [lindex $res 1]

    mddb eval { INSERT INTO frame VALUES($k, $function, $addr) }
    set aFile([lindex [split $addr :] 0]) ""
  }

  foreach f [array names aFile] {
    catch {
      set fd [open $f]
      set text [read $fd]
      close $fd
      mddb eval { INSERT INTO file VALUES($f, $text) }
    }
  }
}

proc open_database {} {
  set zFilename [lindex $::argv 0]
  if {$zFilename eq ""} {
    set zFilename malloc.txt
  }

  lsmtest_report_read $zFilename

  wm title . $zFilename

  mddb function lrange -argcount 3 lrange
  mddb function llength -argcount 1 llength
  mddb function trim_frames -argcount 1 trim_frames

  mddb eval {
    SELECT frame FROM frame 
    WHERE line LIKE '%mem.c:%' 
    OR function LIKE '%Malloc'
    OR function LIKE '%MallocRaw'
    OR function LIKE '%MallocZero'
    OR function LIKE '%Realloc'
  } {
    set ::O(ignore.$frame) 1
  }
}

open_database
bind $O(tree) <<TreeviewSelect>> [list populate_text_widget mddb]

populate_tree_widget mddb [mddb one {SELECT zTest FROM malloc LIMIT 1}]