SQLite

# The library that programs using readline() must link against.
#
LIBREADLINE = @TARGET_READLINE_LIBS@

# Object files for the SQLite library.
#
LIBOBJ = btree.o build.o dbbe.o dbbegdbm.o dbbemem.o delete.o expr.o insert.o \
         main.o pager.o parse.o printf.o random.o select.o table.o \
         tokenize.o update.o util.o vdbe.o where.o tclsqlite.o

# All of the source code files.
#
SRC = \
  $(TOP)/src/btree.c \
  $(TOP)/src/build.c \
  $(TOP)/src/dbbe.c \
  $(TOP)/src/dbbe.h \
  $(TOP)/src/dbbegdbm.c \
  $(TOP)/src/dbbemem.c \
  $(TOP)/src/delete.c \
  $(TOP)/src/expr.c \
  $(TOP)/src/insert.c \
  $(TOP)/src/main.c \
  $(TOP)/src/pager.c \
  $(TOP)/src/parse.y \
  $(TOP)/src/printf.c \
  $(TOP)/src/random.c \
  $(TOP)/src/select.c \
  $(TOP)/src/shell.c \
  $(TOP)/src/sqlite.h.in \
  $(TOP)/src/sqliteInt.h \
  $(TOP)/src/table.c \
  $(TOP)/src/tclsqlite.c \
  $(TOP)/src/tokenize.c \
  $(TOP)/src/update.c \
  $(TOP)/src/util.c \
  $(TOP)/src/vdbe.c \
  $(TOP)/src/vdbe.h \
  $(TOP)/src/where.c

# Source code to the test files.
#
TESTSRC = \
  $(TOP)/src/btree.c \
  $(TOP)/src/pager.c \
  $(TOP)/src/test1.c \
  $(TOP)/src/test2.c \
  $(TOP)/src/test3.c \
  $(TOP)/src/md5.c

# This is the default Makefile target.  The objects listed here
# are what get build when you type just "make" with no arguments.
#
all:	sqlite.h libsqlite.a sqlite 

HDR = \
   sqlite.h  \
   $(TOP)/src/sqliteInt.h  \
   $(TOP)/src/dbbe.h  \
   $(TOP)/src/vdbe.h  \
   parse.h

btree.o:	$(TOP)/src/btree.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/btree.c

build.o:	$(TOP)/src/build.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/build.c

dbbe.o:	$(TOP)/src/dbbe.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/dbbe.c

dbbegdbm.o:	$(TOP)/src/dbbegdbm.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/dbbegdbm.c

dbbemem.o:	$(TOP)/src/dbbemem.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/dbbemem.c

main.o:	$(TOP)/src/main.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/main.c

pager.o:	$(TOP)/src/pager.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/pager.c

parse.o:	parse.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c parse.c

parse.h:	parse.c

parse.c:	$(TOP)/src/parse.y lemon
	cp $(TOP)/src/parse.y .

** Boston, MA  02111-1307, USA.
**
** Author contact information:
**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** $Id: btree.c,v 1.21 2001/08/20 00:33:58 drh Exp $
**
** This file implements a external (disk-based) database using BTrees.
** For a detailed discussion of BTrees, refer to
**
**     Donald E. Knuth, THE ART OF COMPUTER PROGRAMMING, Volume 3:
**     "Sorting And Searching", pages 473-480. Addison-Wesley
**     Publishing Company, Reading, Massachusetts.

** positive if pCur>pKey.
**
** SQLITE_OK is returned on success.  If part of the cursor key
** is on overflow pages and we are unable to access those overflow
** pages, then some other value might be returned to indicate the
** reason for the error.
*/
static int compareKey(
  BtCursor *pCur,      /* Points to the entry against which we are comparing */
  const char *pKey,    /* The comparison key */
  int nKeyOrig,        /* Number of bytes in the comparison key */
  int *pResult         /* Write the comparison results here */
){
  Pgno nextPage;
  int nKey = nKeyOrig;
  int n, c, rc;
  Cell *pCell;

  assert( pCur->pPage );
  assert( pCur->idx>=0 && pCur->idx<pCur->pPage->nCell );

**
**     *pRes==0     The cursor is left pointing at an entry that
**                  exactly matches pKey.
**
**     *pRes>0      The cursor is left pointing at an entry that
**                  is larger than pKey.
*/
int sqliteBtreeMoveto(BtCursor *pCur, const void *pKey, int nKey, int *pRes){
  int rc;
  pCur->bSkipNext = 0;
  rc = moveToRoot(pCur);
  if( rc ) return rc;
  for(;;){
    int lwr, upr;
    Pgno chldPg;

/*
** Create a new cell from key and data.  Overflow pages are allocated as
** necessary and linked to this cell.  
*/
static int fillInCell(
  Btree *pBt,              /* The whole Btree.  Needed to allocate pages */
  Cell *pCell,             /* Populate this Cell structure */
  const void *pKey, int nKey,    /* The key */
  const void *pData,int nData    /* The data */
){
  OverflowPage *pOvfl, *pPrior;
  Pgno *pNext;
  int spaceLeft;
  int n, rc;
  int nPayload;
  const char *pPayload;
  char *pSpace;

  pCell->h.leftChild = 0;
  pCell->h.nKey = nKey;
  pCell->h.nData = nData;
  pCell->h.iNext = 0;

/*
** Insert a new record into the BTree.  The key is given by (pKey,nKey)
** and the data is given by (pData,nData).  The cursor is used only to
** define what database the record should be inserted into.  The cursor
** is left pointing at the new record.
*/
int sqliteBtreeInsert(
  BtCursor *pCur,                /* Insert data into the table of this cursor */
  const void *pKey,  int nKey,   /* The key of the new record */
  const void *pData, int nData   /* The data of the new record */
){
  Cell newCell;
  int rc;
  int loc;
  int szNew;
  MemPage *pPage;
  Btree *pBt = pCur->pBt;

**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** This header file defines the interface that the sqlite B-Tree file
** subsystem.
**
** @(#) $Id: btree.h,v 1.10 2001/08/20 00:33:58 drh Exp $
*/

typedef struct Btree Btree;
typedef struct BtCursor BtCursor;

int sqliteBtreeOpen(const char *zFilename, int mode, int nPg, Btree **ppBtree);
int sqliteBtreeClose(Btree*);

int sqliteBtreeBeginTrans(Btree*);
int sqliteBtreeCommit(Btree*);
int sqliteBtreeRollback(Btree*);

int sqliteBtreeCreateTable(Btree*, int*);
int sqliteBtreeDropTable(Btree*, int);
int sqliteBtreeClearTable(Btree*, int);

int sqliteBtreeCursor(Btree*, int iTable, BtCursor **ppCur);
int sqliteBtreeMoveto(BtCursor*, const void *pKey, int nKey, int *pRes);
int sqliteBtreeDelete(BtCursor*);
int sqliteBtreeInsert(BtCursor*, const void *pKey, int nKey,
                                 const void *pData, int nData);
int sqliteBtreeNext(BtCursor*, int *pRes);
int sqliteBtreeKeySize(BtCursor*, int *pSize);
int sqliteBtreeKey(BtCursor*, int offset, int amt, char *zBuf);
int sqliteBtreeDataSize(BtCursor*, int *pSize);
int sqliteBtreeData(BtCursor*, int offset, int amt, char *zBuf);
int sqliteBtreeCloseCursor(BtCursor*);

** sqlite and the code that does the actually reading and writing
** of information to the disk.
**
** This file uses an in-memory hash table as the database backend. 
** Nothing is ever written to disk using this backend.  All information
** is forgotten when the program exits.
**
** $Id: dbbemem.c,v 1.17 2001/08/20 00:33:58 drh Exp $
*/
#include "sqliteInt.h"
#include <ctype.h>


typedef struct Array Array;
typedef struct ArrayElem ArrayElem;

  /*      BeginIndex */   sqliteMemBeginIndex,
  /*       NextIndex */   sqliteMemNextIndex,
  /*        PutIndex */   sqliteMemPutIndex,
  /*     DeleteIndex */   sqliteMemDeleteIndex,
};

/*
** This routine opens a new database.  For the MEMORY driver
** implemented here, the database name is ignored.  Every MEMORY database
** is unique and is erased when the database is closed.
**
** If successful, a pointer to the Dbbe structure is returned.
** If there are errors, an appropriate error message is left
** in *pzErrMsg and NULL is returned.
*/
Dbbe *sqliteMemOpen(
  const char *zName,     /* The name of the database */

** Author contact information:
**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.22 2001/08/20 00:33:58 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqlite.h"
#include "tcl.h"
#include <stdlib.h>
#include <string.h>

  Tcl_Interp *interp;
  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  Sqlite_Init(interp);
#ifdef SQLITE_TEST
  {
    extern int Sqlitetest1_Init(Tcl_Interp*);
    extern int Sqlitetest2_Init(Tcl_Interp*);
    extern int Sqlitetest3_Init(Tcl_Interp*);
    extern int Md5_Init(Tcl_Interp*);
    Sqlitetest1_Init(interp);
    Sqlitetest2_Init(interp);
    Sqlitetest3_Init(interp);
    Md5_Init(interp);
  }
#endif
  if( argc>=2 ){
    int i;
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);

/*
** Copyright (c) 2001 D. Richard Hipp
**
** This program is free software; you can redistribute it and/or
** modify it under the terms of the GNU General Public
** License as published by the Free Software Foundation; either
** version 2 of the License, or (at your option) any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
** General Public License for more details.
** 
** You should have received a copy of the GNU General Public
** License along with this library; if not, write to the
** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
** Boston, MA  02111-1307, USA.
**
** Author contact information:
**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** Code for testing the pager.c module in SQLite.  This code
** is not included in the SQLite library.  It is used for automated
** testing of the SQLite library.
**
** $Id: test2.c,v 1.4 2001/08/20 00:33:58 drh Exp $
*/
#include "sqliteInt.h"
#include "pager.h"
#include "tcl.h"
#include <stdlib.h>
#include <string.h>

/*
** Interpret an SQLite error number
*/
static char *errorName(int rc){
  char *zName;
  switch( rc ){
    case SQLITE_OK:         zName = "SQLITE_OK";          break;
    case SQLITE_ERROR:      zName = "SQLITE_ERROR";       break;
    case SQLITE_INTERNAL:   zName = "SQLITE_INTERNAL";    break;
    case SQLITE_PERM:       zName = "SQLITE_PERM";        break;
    case SQLITE_ABORT:      zName = "SQLITE_ABORT";       break;
    case SQLITE_BUSY:       zName = "SQLITE_BUSY";        break;
    case SQLITE_NOMEM:      zName = "SQLITE_NOMEM";       break;
    case SQLITE_READONLY:   zName = "SQLITE_READONLY";    break;
    case SQLITE_INTERRUPT:  zName = "SQLITE_INTERRUPT";   break;
    case SQLITE_IOERR:      zName = "SQLITE_IOERR";       break;
    case SQLITE_CORRUPT:    zName = "SQLITE_CORRUPT";     break;
    case SQLITE_NOTFOUND:   zName = "SQLITE_NOTFOUND";    break;
    case SQLITE_FULL:       zName = "SQLITE_FULL";        break;
    case SQLITE_CANTOPEN:   zName = "SQLITE_CANTOPEN";    break;
    case SQLITE_PROTOCOL:   zName = "SQLITE_PROTOCOL";    break;
    default:                zName = "SQLITE_Unknown";     break;
  }
  return zName;
}

/*
** Usage:   pager_open FILENAME N-PAGE
**
** Open a new pager
*/
static int pager_open(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  int nPage;
  int rc;
  char zBuf[100];
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " FILENAME N-PAGE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[2], &nPage) ) return TCL_ERROR;
  rc = sqlitepager_open(&pPager, argv[1], nPage, 0);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf,"0x%x",(int)pPager);
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   pager_close ID
**
** Close the given pager.
*/
static int pager_close(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  rc = sqlitepager_close(pPager);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   pager_rollback ID
**
** Rollback changes
*/
static int pager_rollback(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  rc = sqlitepager_rollback(pPager);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   pager_commit ID
**
** Commit all changes
*/
static int pager_commit(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  rc = sqlitepager_commit(pPager);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   pager_stats ID
**
** Return pager statistics.
*/
static int pager_stats(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  int i, *a;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  a = sqlitepager_stats(pPager);
  for(i=0; i<9; i++){
    static char *zName[] = {
      "ref", "page", "max", "size", "state", "err",
      "hit", "miss", "ovfl",
    };
    char zBuf[100];
    Tcl_AppendElement(interp, zName[i]);
    sprintf(zBuf,"%d",a[i]);
    Tcl_AppendElement(interp, zBuf);
  }
  return TCL_OK;
}

/*
** Usage:   pager_pagecount ID
**
** Return the size of the database file.
*/
static int pager_pagecount(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  char zBuf[100];
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  sprintf(zBuf,"%d",sqlitepager_pagecount(pPager));
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   page_get ID PGNO
**
** Return a pointer to a page from the database.
*/
static int page_get(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  char zBuf[100];
  void *pPage;
  int pgno;
  int rc;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID PGNO\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR;
  rc = sqlitepager_get(pPager, pgno, &pPage);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf,"0x%x",(int)pPage);
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   page_lookup ID PGNO
**
** Return a pointer to a page if the page is already in cache.
** If not in cache, return an empty string.
*/
static int page_lookup(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Pager *pPager;
  char zBuf[100];
  void *pPage;
  int pgno;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID PGNO\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPager) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR;
  pPage = sqlitepager_lookup(pPager, pgno);
  if( pPage ){
    sprintf(zBuf,"0x%x",(int)pPage);
    Tcl_AppendResult(interp, zBuf, 0);
  }
  return TCL_OK;
}

/*
** Usage:   page_unref PAGE
**
** Drop a pointer to a page.
*/
static int page_unref(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  void *pPage;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " PAGE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPage) ) return TCL_ERROR;
  rc = sqlitepager_unref(pPage);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   page_read PAGE
**
** Return the content of a page
*/
static int page_read(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  char zBuf[100];
  void *pPage;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " PAGE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPage) ) return TCL_ERROR;
  memcpy(zBuf, pPage, sizeof(zBuf));
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   page_number PAGE
**
** Return the page number for a page.
*/
static int page_number(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  char zBuf[100];
  void *pPage;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " PAGE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPage) ) return TCL_ERROR;
  sprintf(zBuf, "%d", sqlitepager_pagenumber(pPage));
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   page_write PAGE DATA
**
** Write something into a page.
*/
static int page_write(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  void *pPage;
  int rc;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " PAGE DATA\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pPage) ) return TCL_ERROR;
  rc = sqlitepager_write(pPage);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  strncpy((char*)pPage, argv[2], SQLITE_PAGE_SIZE-1);
  ((char*)pPage)[SQLITE_PAGE_SIZE-1] = 0;
  return TCL_OK;
}

/*
** Register commands with the TCL interpreter.
*/
int Sqlitetest2_Init(Tcl_Interp *interp){
  Tcl_CreateCommand(interp, "pager_open", pager_open, 0, 0);
  Tcl_CreateCommand(interp, "pager_close", pager_close, 0, 0);
  Tcl_CreateCommand(interp, "pager_commit", pager_commit, 0, 0);
  Tcl_CreateCommand(interp, "pager_rollback", pager_rollback, 0, 0);
  Tcl_CreateCommand(interp, "pager_stats", pager_stats, 0, 0);
  Tcl_CreateCommand(interp, "pager_pagecount", pager_pagecount, 0, 0);
  Tcl_CreateCommand(interp, "page_get", page_get, 0, 0);
  Tcl_CreateCommand(interp, "page_lookup", page_lookup, 0, 0);
  Tcl_CreateCommand(interp, "page_unref", page_unref, 0, 0);
  Tcl_CreateCommand(interp, "page_read", page_read, 0, 0);
  Tcl_CreateCommand(interp, "page_write", page_write, 0, 0);
  Tcl_CreateCommand(interp, "page_number", page_number, 0, 0);
  return TCL_OK;
}

/*
** Copyright (c) 2001 D. Richard Hipp
**
** This program is free software; you can redistribute it and/or
** modify it under the terms of the GNU General Public
** License as published by the Free Software Foundation; either
** version 2 of the License, or (at your option) any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
** General Public License for more details.
** 
** You should have received a copy of the GNU General Public
** License along with this library; if not, write to the
** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
** Boston, MA  02111-1307, USA.
**
** Author contact information:
**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** Code for testing the btree.c module in SQLite.  This code
** is not included in the SQLite library.  It is used for automated
** testing of the SQLite library.
**
** $Id: test3.c,v 1.9 2001/08/20 00:33:58 drh Exp $
*/
#include "sqliteInt.h"
#include "pager.h"
#include "btree.h"
#include "tcl.h"
#include <stdlib.h>
#include <string.h>

/*
** Interpret an SQLite error number
*/
static char *errorName(int rc){
  char *zName;
  switch( rc ){
    case SQLITE_OK:         zName = "SQLITE_OK";          break;
    case SQLITE_ERROR:      zName = "SQLITE_ERROR";       break;
    case SQLITE_INTERNAL:   zName = "SQLITE_INTERNAL";    break;
    case SQLITE_PERM:       zName = "SQLITE_PERM";        break;
    case SQLITE_ABORT:      zName = "SQLITE_ABORT";       break;
    case SQLITE_BUSY:       zName = "SQLITE_BUSY";        break;
    case SQLITE_NOMEM:      zName = "SQLITE_NOMEM";       break;
    case SQLITE_READONLY:   zName = "SQLITE_READONLY";    break;
    case SQLITE_INTERRUPT:  zName = "SQLITE_INTERRUPT";   break;
    case SQLITE_IOERR:      zName = "SQLITE_IOERR";       break;
    case SQLITE_CORRUPT:    zName = "SQLITE_CORRUPT";     break;
    case SQLITE_NOTFOUND:   zName = "SQLITE_NOTFOUND";    break;
    case SQLITE_FULL:       zName = "SQLITE_FULL";        break;
    case SQLITE_CANTOPEN:   zName = "SQLITE_CANTOPEN";    break;
    case SQLITE_PROTOCOL:   zName = "SQLITE_PROTOCOL";    break;
    default:                zName = "SQLITE_Unknown";     break;
  }
  return zName;
}

/*
** Usage:   btree_open FILENAME
**
** Open a new database
*/
static int btree_open(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  char zBuf[100];
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " FILENAME\"", 0);
    return TCL_ERROR;
  }
  rc = sqliteBtreeOpen(argv[1], 0666, 10, &pBt);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf,"0x%x",(int)pBt);
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   btree_close ID
**
** Close the given database.
*/
static int btree_close(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeClose(pBt);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_begin_transaction ID
**
** Start a new transaction
*/
static int btree_begin_transaction(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeBeginTrans(pBt);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_rollback ID
**
** Rollback changes
*/
static int btree_rollback(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeRollback(pBt);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_commit ID
**
** Commit all changes
*/
static int btree_commit(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeCommit(pBt);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_create_table ID
**
** Create a new table in the database
*/
static int btree_create_table(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc, iTable;
  char zBuf[30];
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeCreateTable(pBt, &iTable);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf, "%d", iTable);
  Tcl_AppendResult(interp, zBuf, 0);
  return TCL_OK;
}

/*
** Usage:   btree_drop_table ID TABLENUM
**
** Delete an entire table from the database
*/
static int btree_drop_table(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int iTable;
  int rc;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID TABLENUM\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &iTable) ) return TCL_ERROR;
  rc = sqliteBtreeDropTable(pBt, iTable);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_clear_table ID TABLENUM
**
** Remove all entries from the given table but keep the table around.
*/
static int btree_clear_table(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int iTable;
  int rc;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID TABLENUM\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &iTable) ) return TCL_ERROR;
  rc = sqliteBtreeClearTable(pBt, iTable);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_get_meta ID
**
** Return meta data
*/
static int btree_get_meta(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  int i;
  int aMeta[SQLITE_N_BTREE_META];
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  rc = sqliteBtreeGetMeta(pBt, aMeta);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  for(i=0; i<SQLITE_N_BTREE_META; i++){
    char zBuf[30];
    sprintf(zBuf,"%d",aMeta[i]);
    Tcl_AppendElement(interp, zBuf);
  }
  return TCL_OK;
}

/*
** Usage:   btree_update_meta ID METADATA...
**
** Return meta data
*/
static int btree_update_meta(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int rc;
  int i;
  int aMeta[SQLITE_N_BTREE_META];

  if( argc!=2+SQLITE_N_BTREE_META ){
    char zBuf[30];
    sprintf(zBuf,"%d",SQLITE_N_BTREE_META);
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID METADATA...\" (METADATA is ", zBuf, " integers)", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  for(i=0; i<SQLITE_N_BTREE_META; i++){
    if( Tcl_GetInt(interp, argv[i+2], &aMeta[i]) ) return TCL_ERROR;
  }
  rc = sqliteBtreeUpdateMeta(pBt, aMeta);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_page_dump ID PAGENUM
**
** Print a disassembly of a page on standard output
*/
static int btree_page_dump(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int iPage;
  int rc;

  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &iPage) ) return TCL_ERROR;
  rc = sqliteBtreePageDump(pBt, iPage, 0);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_tree_dump ID PAGENUM
**
** Print a disassembly of a page and all its child pages on standard output
*/
static int btree_tree_dump(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int iPage;
  int rc;

  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &iPage) ) return TCL_ERROR;
  rc = sqliteBtreePageDump(pBt, iPage, 1);
  if( rc!=SQLITE_OK ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/*
** Usage:   btree_pager_stats ID
**
** Returns pager statistics
*/
static int btree_pager_stats(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int i;
  int *a;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  a = sqlitepager_stats(sqliteBtreePager(pBt));
  for(i=0; i<9; i++){
    static char *zName[] = {
      "ref", "page", "max", "size", "state", "err",
      "hit", "miss", "ovfl",
    };
    char zBuf[100];
    Tcl_AppendElement(interp, zName[i]);
    sprintf(zBuf,"%d",a[i]);
    Tcl_AppendElement(interp, zBuf);
  }
  return TCL_OK;
}

/*
** Usage:   btree_pager_ref_dump ID
**
** Print out all outstanding pages.
*/
static int btree_pager_ref_dump(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  sqlitepager_refdump(sqliteBtreePager(pBt));
  return TCL_OK;
}

/*
** Usage:   btree_sanity_check ID ROOT ...
**
** Look through every page of the given BTree file to verify correct
** formatting and linkage.  Return a line of text for each problem found.
** Return an empty string if everything worked.
*/
static int btree_sanity_check(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  char *zResult;
  int nRoot;
  int *aRoot;
  int i;

  if( argc<3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID ROOT ...\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  nRoot = argc-2;
  aRoot = malloc( sizeof(int)*(argc-2) );
  for(i=0; i<argc-2; i++){
    if( Tcl_GetInt(interp, argv[i+2], &aRoot[i]) ) return TCL_ERROR;
  }
  zResult = sqliteBtreeSanityCheck(pBt, aRoot, nRoot);
  if( zResult ){
    Tcl_AppendResult(interp, zResult, 0);
    free(zResult); 
  }
  return TCL_OK;
}

/*
** Usage:   btree_cursor ID TABLENUM
**
** Create a new cursor.  Return the ID for the cursor.
*/
static int btree_cursor(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  Btree *pBt;
  int iTable;
  BtCursor *pCur;
  int rc;
  char zBuf[30];

  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID TABLENUM\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pBt) ) return TCL_ERROR;
  if( Tcl_GetInt(interp, argv[2], &iTable) ) return TCL_ERROR;
  rc = sqliteBtreeCursor(pBt, iTable, &pCur);
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf,"0x%x", (int)pCur);
  Tcl_AppendResult(interp, zBuf, 0);
  return SQLITE_OK;
}

/*
** Usage:   btree_close_cursor ID
**
** Close a cursor opened using btree_cursor.
*/
static int btree_close_cursor(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeCloseCursor(pCur);
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return SQLITE_OK;
}

/*
** Usage:   btree_move_to ID KEY
**
** Move the cursor to the entry with the given key.
*/
static int btree_move_to(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;
  int res;
  char zBuf[20];

  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID KEY\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeMoveto(pCur, argv[2], strlen(argv[2]), &res);  
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sprintf(zBuf,"%d",res);
  Tcl_AppendResult(interp, zBuf, 0);
  return SQLITE_OK;
}

/*
** Usage:   btree_delete ID
**
** Delete the entry that the cursor is pointing to
*/
static int btree_delete(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeDelete(pCur);
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return SQLITE_OK;
}

/*
** Usage:   btree_insert ID KEY DATA
**
** Create a new entry with the given key and data.  If an entry already
** exists with the same key the old entry is overwritten.
*/
static int btree_insert(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;

  if( argc!=4 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID KEY DATA\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeInsert(pCur, argv[2], strlen(argv[2]),
                         argv[3], strlen(argv[3]));
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return SQLITE_OK;
}

/*
** Usage:   btree_next ID
**
** Move the cursor to the next entry in the table.
*/
static int btree_next(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeNext(pCur, 0);
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  return SQLITE_OK;
}

/*
** Usage:   btree_key ID
**
** Return the key for the entry at which the cursor is pointing.
*/
static int btree_key(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;
  int n;
  char *zBuf;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  sqliteBtreeKeySize(pCur, &n);
  zBuf = malloc( n+1 );
  rc = sqliteBtreeKey(pCur, 0, n, zBuf);
  if( rc ){
    free(zBuf);
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  zBuf[n] = 0;
  Tcl_AppendResult(interp, zBuf, 0);
  free(zBuf);
  return SQLITE_OK;
}

/*
** Usage:   btree_data ID
**
** Return the data for the entry at which the cursor is pointing.
*/
static int btree_data(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;
  int n;
  char *zBuf;

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  sqliteBtreeDataSize(pCur, &n);
  zBuf = malloc( n+1 );
  rc = sqliteBtreeData(pCur, 0, n, zBuf);
  if( rc ){
    free(zBuf);
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  zBuf[n] = 0;
  Tcl_AppendResult(interp, zBuf, 0);
  free(zBuf);
  return SQLITE_OK;
}

/*
** Usage:   btree_cursor_dump ID
**
** Return eight integers containing information about the entry the
** cursor is pointing to:
**
**   aResult[0] =  The page number
**   aResult[1] =  The entry number
**   aResult[2] =  Total number of entries on this page
**   aResult[3] =  Size of this entry
**   aResult[4] =  Number of free bytes on this page
**   aResult[5] =  Number of free blocks on the page
**   aResult[6] =  Page number of the left child of this entry
**   aResult[7] =  Page number of the right child for the whole page
*/
static int btree_cursor_dump(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  BtCursor *pCur;
  int rc;
  int i, j;
  int aResult[8];
  char zBuf[400];

  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], (int*)&pCur) ) return TCL_ERROR;
  rc = sqliteBtreeCursorDump(pCur, aResult);
  if( rc ){
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  j = 0;
  for(i=0; i<sizeof(aResult)/sizeof(aResult[0]); i++){
    sprintf(&zBuf[j]," %d", aResult[i]);
    j += strlen(&zBuf[j]);
  }
  Tcl_AppendResult(interp, &zBuf[1], 0);
  return SQLITE_OK;
}

/*
** Register commands with the TCL interpreter.
*/
int Sqlitetest3_Init(Tcl_Interp *interp){
  Tcl_CreateCommand(interp, "btree_open", btree_open, 0, 0);
  Tcl_CreateCommand(interp, "btree_close", btree_close, 0, 0);
  Tcl_CreateCommand(interp, "btree_begin_transaction",
      btree_begin_transaction, 0, 0);
  Tcl_CreateCommand(interp, "btree_commit", btree_commit, 0, 0);
  Tcl_CreateCommand(interp, "btree_rollback", btree_rollback, 0, 0);
  Tcl_CreateCommand(interp, "btree_create_table", btree_create_table, 0, 0);
  Tcl_CreateCommand(interp, "btree_drop_table", btree_drop_table, 0, 0);
  Tcl_CreateCommand(interp, "btree_clear_table", btree_clear_table, 0, 0);
  Tcl_CreateCommand(interp, "btree_get_meta", btree_get_meta, 0, 0);
  Tcl_CreateCommand(interp, "btree_update_meta", btree_update_meta, 0, 0);
  Tcl_CreateCommand(interp, "btree_page_dump", btree_page_dump, 0, 0);
  Tcl_CreateCommand(interp, "btree_tree_dump", btree_tree_dump, 0, 0);
  Tcl_CreateCommand(interp, "btree_pager_stats", btree_pager_stats, 0, 0);
  Tcl_CreateCommand(interp, "btree_pager_ref_dump", btree_pager_ref_dump, 0, 0);
  Tcl_CreateCommand(interp, "btree_cursor", btree_cursor, 0, 0);
  Tcl_CreateCommand(interp, "btree_close_cursor", btree_close_cursor, 0, 0);
  Tcl_CreateCommand(interp, "btree_move_to", btree_move_to, 0, 0);
  Tcl_CreateCommand(interp, "btree_delete", btree_delete, 0, 0);
  Tcl_CreateCommand(interp, "btree_insert", btree_insert, 0, 0);
  Tcl_CreateCommand(interp, "btree_next", btree_next, 0, 0);
  Tcl_CreateCommand(interp, "btree_key", btree_key, 0, 0);
  Tcl_CreateCommand(interp, "btree_data", btree_data, 0, 0);
  Tcl_CreateCommand(interp, "btree_cursor_dump", btree_cursor_dump, 0, 0);
  Tcl_CreateCommand(interp, "btree_sanity_check", btree_sanity_check, 0, 0);
  Tcl_LinkVar(interp, "pager_refinfo_enable", (char*)&pager_refinfo_enable,
     TCL_LINK_INT);
  return TCL_OK;
}

# Copyright (c) 1999, 2000 D. Richard Hipp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# Author contact information:
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is btree database backend
#
# $Id: btree.test,v 1.8 2001/08/20 00:33:58 drh Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl

if {[info commands btree_open]!=""} {

# Basic functionality.  Open and close a database.
#
do_test btree-1.1 {
  file delete -force test1.bt
  file delete -force test1.bt-journal
  set rc [catch {btree_open test1.bt} ::b1]
} {0}

# The second element of the list returned by btree_pager_stats is the
# number of pages currently checked out.  We'll be checking this value
# frequently during this test script, to make sure the btree library
# is properly releasing the pages it checks out, and thus avoiding
# page leaks.
#
do_test btree-1.1.1 {
  lindex [btree_pager_stats $::b1] 1
} {0}
do_test btree-1.2 {
  set rc [catch {btree_open test1.bt} ::b2]
} {0}
do_test btree-1.3 {
  set rc [catch {btree_close $::b2} msg]
  lappend rc $msg
} {0 {}}

# Do an insert and verify that the database file grows in size.
#
do_test btree-1.4 {
  set rc [catch {btree_begin_transaction $::b1} msg]
  lappend rc $msg
} {0 {}}
do_test btree-1.4.1 {
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-1.5 {
  set rc [catch {btree_cursor $::b1 2} ::c1]
  if {$rc} {lappend rc $::c1}
  set rc
} {0}
do_test btree-1.6 {
  set rc [catch {btree_insert $::c1 one 1.00} msg]
  lappend rc $msg
} {0 {}}
do_test btree-1.7 {
  btree_key $::c1
} {one}
do_test btree-1.8 {
  btree_data $::c1
} {1.00}
do_test btree-1.9 {
  set rc [catch {btree_close_cursor $::c1} msg]
  lappend rc $msg
} {0 {}}
do_test btree-1.10 {
  set rc [catch {btree_commit $::b1} msg]
  lappend rc $msg
} {0 {}}
do_test btree-1.11 {
  file size test1.bt
} {2048}
do_test btree-1.12 {
  lindex [btree_pager_stats $::b1] 1
} {0}

# Reopen the database and attempt to read the record that we wrote.
#
do_test btree-2.1 {
  set rc [catch {btree_cursor $::b1 2} ::c1]
  if {$rc} {lappend rc $::c1}
  set rc
} {0}
do_test btree-2.2 {
  btree_move_to $::c1 abc
} {1}
do_test btree-2.3 {
  btree_move_to $::c1 xyz
} {-1}
do_test btree-2.4 {
  btree_move_to $::c1 one
} {0}
do_test btree-2.5 {
  btree_key $::c1
} {one}
do_test btree-2.6 {
  btree_data $::c1
} {1.00}
do_test btree-2.7 {
  lindex [btree_pager_stats $::b1] 1
} {2}

# Do some additional inserts
#
do_test btree-3.1 {
  btree_begin_transaction $::b1
  btree_insert $::c1 two 2.00
  btree_key $::c1
} {two}
do_test btree-3.1.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-3.2 {
  btree_insert $::c1 three 3.00
  btree_key $::c1
} {three}
do_test btree-3.4 {
  btree_insert $::c1 four 4.00
  btree_key $::c1
} {four}
do_test btree-3.5 {
  btree_insert $::c1 five 5.00
  btree_key $::c1
} {five}
do_test btree-3.6 {
  btree_insert $::c1 six 6.00
  btree_key $::c1
} {six}
#btree_page_dump $::b1 2
do_test btree-3.7 {
  set rc [btree_move_to $::c1 {}]
  expr {$rc>0}
} {1}
do_test btree-3.8 {
  btree_key $::c1
} {five}
do_test btree-3.9 {
  btree_data $::c1
} {5.00}
do_test btree-3.10 {
  btree_next $::c1
  btree_key $::c1
} {four}
do_test btree-3.11 {
  btree_data $::c1
} {4.00}
do_test btree-3.12 {
  btree_next $::c1
  btree_key $::c1
} {one}
do_test btree-3.13 {
  btree_data $::c1
} {1.00}
do_test btree-3.14 {
  btree_next $::c1
  btree_key $::c1
} {six}
do_test btree-3.15 {
  btree_data $::c1
} {6.00}
do_test btree-3.16 {
  btree_next $::c1
  btree_key $::c1
} {three}
do_test btree-3.17 {
  btree_data $::c1
} {3.00}
do_test btree-3.18 {
  btree_next $::c1
  btree_key $::c1
} {two}
do_test btree-3.19 {
  btree_data $::c1
} {2.00}
do_test btree-3.20 {
  btree_next $::c1
  btree_key $::c1
} {}
do_test btree-3.21 {
  btree_data $::c1
} {}

# Commit the changes, reopen and reread the data
#
do_test btree-3.22 {
  set rc [catch {btree_close_cursor $::c1} msg]
  lappend rc $msg
} {0 {}}
do_test btree-3.22.1 {
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-3.23 {
  set rc [catch {btree_commit $::b1} msg]
  lappend rc $msg
} {0 {}}
do_test btree-3.23.1 {
  lindex [btree_pager_stats $::b1] 1
} {0}
do_test btree-3.24 {
  file size test1.bt
} {2048}
do_test btree-3.25 {
  set rc [catch {btree_cursor $::b1 2} ::c1]
  if {$rc} {lappend rc $::c1}
  set rc
} {0}
do_test btree-3.25.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-3.26 {
  set rc [btree_move_to $::c1 {}]
  expr {$rc>0}
} {1}
do_test btree-3.27 {
  btree_key $::c1
} {five}
do_test btree-3.28 {
  btree_data $::c1
} {5.00}
do_test btree-3.29 {
  btree_next $::c1
  btree_key $::c1
} {four}
do_test btree-3.30 {
  btree_data $::c1
} {4.00}
do_test btree-3.31 {
  btree_next $::c1
  btree_key $::c1
} {one}
do_test btree-3.32 {
  btree_data $::c1
} {1.00}
do_test btree-3.33 {
  btree_next $::c1
  btree_key $::c1
} {six}
do_test btree-3.34 {
  btree_data $::c1
} {6.00}
do_test btree-3.35 {
  btree_next $::c1
  btree_key $::c1
} {three}
do_test btree-3.36 {
  btree_data $::c1
} {3.00}
do_test btree-3.37 {
  btree_next $::c1
  btree_key $::c1
} {two}
do_test btree-3.38 {
  btree_data $::c1
} {2.00}
do_test btree-3.39 {
  btree_next $::c1
  btree_key $::c1
} {}
do_test btree-3.40 {
  btree_data $::c1
} {}
do_test btree-3.41 {
  lindex [btree_pager_stats $::b1] 1
} {2}


# Now try a delete
#
do_test btree-4.1 {
  btree_begin_transaction $::b1
  btree_move_to $::c1 one
  btree_key $::c1
} {one}
do_test btree-4.1.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-4.2 {
  btree_delete $::c1
} {}
do_test btree-4.3 {
  btree_key $::c1
} {six}
do_test btree-4.4 {
  btree_next $::c1
  btree_key $::c1
} {six}
do_test btree-4.5 {
  btree_next $::c1
  btree_key $::c1
} {three}
do_test btree-4.4 {
  btree_move_to $::c1 {}
  set r {}
  while 1 {
    set key [btree_key $::c1]
    if {$key==""} break
    lappend r $key
    lappend r [btree_data $::c1]
    btree_next $::c1
  }
  set r   
} {five 5.00 four 4.00 six 6.00 three 3.00 two 2.00}

# Commit and make sure the delete is still there.
#
do_test btree-4.5 {
  btree_commit $::b1
  btree_move_to $::c1 {}
  set r {}
  while 1 {
    set key [btree_key $::c1]
    if {$key==""} break
    lappend r $key
    lappend r [btree_data $::c1]
    btree_next $::c1
  }
  set r   
} {five 5.00 four 4.00 six 6.00 three 3.00 two 2.00}

# Completely close the database and reopen it.  Then check
# the data again.
#
do_test btree-4.6 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-4.7 {
  btree_close_cursor $::c1
  lindex [btree_pager_stats $::b1] 1
} {0}
do_test btree-4.8 {
  btree_close $::b1
  set ::b1 [btree_open test1.bt]
  set ::c1 [btree_cursor $::b1 2]
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-4.9 {
  set r {}
  while 1 {
    set key [btree_key $::c1]
    if {$key==""} break
    lappend r $key
    lappend r [btree_data $::c1]
    btree_next $::c1
  }
  set r   
} {five 5.00 four 4.00 six 6.00 three 3.00 two 2.00}

# Try to read and write meta data
#
do_test btree-5.1 {
  btree_get_meta $::b1
} {0 0 0 0}
do_test btree-5.2 {
  set rc [catch {btree_update_meta $::b1 1 2 3 4} msg]
  lappend rc $msg
} {1 SQLITE_ERROR}
do_test btree-5.3 {
  btree_begin_transaction $::b1
  set rc [catch {btree_update_meta $::b1 1 2 3 4} msg]
  lappend rc $msg
} {0 {}}
do_test btree-5.4 {
  btree_get_meta $::b1
} {0 2 3 4}
do_test btree-5.5 {
  btree_close_cursor $::c1
  btree_rollback $::b1
  btree_get_meta $::b1
} {0 0 0 0}
do_test btree-5.6 {
  btree_begin_transaction $::b1
  btree_update_meta $::b1 999 10 20 30
  btree_commit $::b1
  btree_get_meta $::b1
} {0 10 20 30}

proc select_all {cursor} {
  set r {}
  btree_move_to $cursor {}
  while 1 {
    set key [btree_key $cursor]
    if {$key==""} break
    lappend r $key
    lappend r [btree_data $cursor]
    btree_next $cursor
  }
  return $r
}
proc select_keys {cursor} {
  set r {}
  btree_move_to $cursor {}
  while 1 {
    set key [btree_key $cursor]
    if {$key==""} break
    lappend r $key
    btree_next $cursor
  }
  return $r
}

# Try to create a new table in the database file
#
do_test btree-6.1 {
  set rc [catch {btree_create_table $::b1} msg]
  lappend rc $msg
} {1 SQLITE_ERROR}
do_test btree-6.2 {
  btree_begin_transaction $::b1
  set ::t2 [btree_create_table $::b1]
} {3}
do_test btree-6.2.1 {
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-6.2.2 {
  set ::c2 [btree_cursor $::b1 $::t2]
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-6.2.3 {
  btree_insert $::c2 ten 10
  btree_key $::c2
} {ten}
do_test btree-6.3 {
  btree_commit $::b1
  set ::c1 [btree_cursor $::b1 2]
  lindex [btree_pager_stats $::b1] 1
} {3}
do_test btree-6.3.1 {
  select_all $::c1
} {five 5.00 four 4.00 six 6.00 three 3.00 two 2.00}
#btree_page_dump $::b1 3
do_test btree-6.4 {
  select_all $::c2
} {ten 10}

# Drop the new table, then create it again anew.
#
do_test btree-6.5 {
  btree_begin_transaction $::b1
} {}
do_test btree-6.6 {
  btree_close_cursor $::c2
} {}
do_test btree-6.6.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-6.7 {
  btree_drop_table $::b1 $::t2
} {}
do_test btree-6.7.1 {
  lindex [btree_get_meta $::b1] 0
} {1}
do_test btree-6.8 {
  set ::t2 [btree_create_table $::b1]
} {3}
do_test btree-6.8.1 {
  lindex [btree_get_meta $::b1] 0
} {0}
do_test btree-6.9 {
  set ::c2 [btree_cursor $::b1 $::t2]
  lindex [btree_pager_stats $::b1] 1
} {3}

do_test btree-6.9.1 {
  btree_move_to $::c2 {}
  btree_key $::c2
} {}

# If we drop table 2 it just clears the table.  Table 2 always exists.
#
do_test btree-6.10 {
  btree_close_cursor $::c1
  btree_drop_table $::b1 2
  set ::c1 [btree_cursor $::b1 2]
  btree_move_to $::c1 {}
  btree_key $::c1
} {}
do_test btree-6.11 {
  btree_commit $::b1
  select_all $::c1
} {}
do_test btree-6.12 {
  select_all $::c2
} {}
do_test btree-6.13 {
  btree_close_cursor $::c2
  lindex [btree_pager_stats $::b1] 1
} {2}

# Check to see that pages defragment properly.  To do this test we will
# 
#   1.  Fill the first page table 2 with data.
#   2.  Delete every other entry of table 2. 
#   3.  Insert a single entry that requires more contiguous
#       space than is available.
#
do_test btree-7.1 {
  btree_begin_transaction $::b1
} {}
catch {unset key}
catch {unset data}
do_test btree-7.2 {
  for {set i 0} {$i<36} {incr i} {
    set key [format %03d $i]
    set data "*** $key ***"
    btree_insert $::c1 $key $data
  }
  lrange [btree_cursor_dump $::c1] 4 5
} {8 1}
do_test btree-7.3 {
  btree_move_to $::c1 000
  while {[btree_key $::c1]!=""} {
    btree_delete $::c1
    btree_next $::c1
    btree_next $::c1
  }
  lrange [btree_cursor_dump $::c1] 4 5
} {512 19}
#btree_page_dump $::b1 2
do_test btree-7.4 {
  btree_insert $::c1 018 {*** 018 ***+++}
  btree_key $::c1
} {018}
do_test btree-7.5 {
  lrange [btree_cursor_dump $::c1] 4 5
} {480 1}
#btree_page_dump $::b1 2

# Delete an entry to make a hole of a known size, then immediately recreate
# that entry.  This tests the path into allocateSpace where the hole exactly
# matches the size of the desired space.
#
do_test btree-7.6 {
  btree_move_to $::c1 007
  btree_delete $::c1
  btree_move_to $::c1 011
  btree_delete $::c1
} {}
do_test btree-7.7 {
  lindex [btree_cursor_dump $::c1] 5
} {3}
#btree_page_dump $::b1 2
do_test btree-7.8 {
  btree_insert $::c1 007 {*** 007 ***}
  lindex [btree_cursor_dump $::c1] 5
} {2}
#btree_page_dump $::b1 2

# Make sure the freeSpace() routine properly coaleses adjacent memory blocks
#
do_test btree-7.9 {
  btree_move_to $::c1 013
  btree_delete $::c1
  lrange [btree_cursor_dump $::c1] 4 5
} {536 2}
do_test btree-7.10 {
  btree_move_to $::c1 009
  btree_delete $::c1
  lrange [btree_cursor_dump $::c1] 4 5
} {564 2}
do_test btree-7.11 {
  btree_move_to $::c1 018
  btree_delete $::c1
  lrange [btree_cursor_dump $::c1] 4 5
} {596 2}
do_test btree-7.13 {
  btree_move_to $::c1 033
  btree_delete $::c1
  lrange [btree_cursor_dump $::c1] 4 5
} {624 3}
do_test btree-7.14 {
  btree_move_to $::c1 035
  btree_delete $::c1
  lrange [btree_cursor_dump $::c1] 4 5
} {652 2}
#btree_page_dump $::b1 2
do_test btree-7.15 {
  lindex [btree_pager_stats $::b1] 1
} {2}

# Check to see that data on overflow pages work correctly.
#
do_test btree-8.1 {
  set data "*** This is a very long key "
  while {[string length $data]<256} {append data $data}
  set ::data $data
  btree_insert $::c1 020 $data
} {}
#btree_page_dump $::b1 2
do_test btree-8.1.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
#btree_pager_ref_dump $::b1
do_test btree-8.2 {
  string length [btree_data $::c1]
} [string length $::data]
do_test btree-8.3 {
  btree_data $::c1
} $::data
do_test btree-8.4 {
  btree_delete $::c1
} {}
do_test btree-8.4.1 {
  lindex [btree_get_meta $::b1] 0
} [expr {int(([string length $::data]-238+1019)/1020)}]
do_test btree-8.5 {
  set data "*** This is an even longer key"
  while {[string length $data]<2000} {append data $data}
  set ::data $data
  btree_insert $::c1 020 $data
} {}
do_test btree-8.6 {
  string length [btree_data $::c1]
} [string length $::data]
do_test btree-8.7 {
  btree_data $::c1
} $::data
do_test btree-8.8 {
  btree_commit $::b1
  btree_data $::c1
} $::data
do_test btree-8.9 {
  btree_close_cursor $::c1
  btree_close $::b1
  set ::b1 [btree_open test1.bt]
  set ::c1 [btree_cursor $::b1 2]
  btree_move_to $::c1 020
  btree_data $::c1
} $::data
do_test btree-8.10 {
  btree_begin_transaction $::b1
  btree_delete $::c1
} {}
do_test btree-8.11 {
  lindex [btree_get_meta $::b1] 0
} [expr {int(([string length $::data]-238+1019)/1020)}]

# Now check out keys on overflow pages.
#
do_test btree-8.12 {
  set ::keyprefix "This is a long prefix to a key "
  while {[string length $::keyprefix]<256} {append ::keyprefix $::keyprefix}
  btree_close_cursor $::c1
  btree_drop_table $::b1 2
  lindex [btree_get_meta $::b1] 0
} {4}
do_test btree-8.12.1 {
  set ::c1 [btree_cursor $::b1 2]
  btree_insert $::c1 ${::keyprefix}1 1
  btree_data $::c1
} {1}
do_test btree-8.13 {
  btree_key $::c1
} ${keyprefix}1
do_test btree-8.14 {
  btree_insert $::c1 ${::keyprefix}2 2
  btree_insert $::c1 ${::keyprefix}3 3
  btree_key $::c1
} ${keyprefix}3
do_test btree-8.15 {
  btree_move_to $::c1 ${::keyprefix}2
  btree_data $::c1
} {2}
do_test btree-8.16 {
  btree_move_to $::c1 ${::keyprefix}1
  btree_data $::c1
} {1}
do_test btree-8.17 {
  btree_move_to $::c1 ${::keyprefix}3
  btree_data $::c1
} {3}
do_test btree-8.18 {
  lindex [btree_get_meta $::b1] 0
} {1}
do_test btree-8.19 {
  btree_move_to $::c1 ${::keyprefix}2
  btree_key $::c1
} ${::keyprefix}2
#btree_page_dump $::b1 2
do_test btree-8.20 {
  btree_delete $::c1
  btree_next $::c1
  btree_key $::c1
} ${::keyprefix}3
#btree_page_dump $::b1 2
do_test btree-8.21 {
  lindex [btree_get_meta $::b1] 0
} {2}
do_test btree-8.22 {
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-8.23 {
  btree_close_cursor $::c1
  btree_drop_table $::b1 2
  set ::c1 [btree_cursor $::b1 2]
  lindex [btree_get_meta $::b1] 0
} {4}
do_test btree-8.24 {
  lindex [btree_pager_stats $::b1] 1
} {2}
#btree_pager_ref_dump $::b1

# Check page splitting logic
#
do_test btree-9.1 {
  for {set i 1} {$i<=19} {incr i} {
    set key [format %03d $i]
    set data "*** $key *** $key *** $key *** $key ***"
    btree_insert $::c1 $key $data
  }
} {}
#btree_tree_dump $::b1 2
#btree_pager_ref_dump $::b1
#set pager_refinfo_enable 1
do_test btree-9.2 {
  btree_insert $::c1 020 {*** 020 *** 020 *** 020 *** 020 ***}
  select_keys $::c1
} {001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020}
#btree_page_dump $::b1 5
#btree_page_dump $::b1 2
#btree_page_dump $::b1 7
#btree_pager_ref_dump $::b1
#set pager_refinfo_enable 0

# The previous "select_keys" command left the cursor pointing at the root
# page.  So there should only be two pages checked out.  2 (the root) and
# page 1.
do_test btree-9.2.1 {
  lindex [btree_pager_stats $::b1] 1
} {2}
for {set i 1} {$i<=20} {incr i} {
  do_test btree-9.3.$i.1 [subst {
    btree_move_to $::c1 [format %03d $i]
    btree_key $::c1
  }] [format %03d $i]
  do_test btree-9.3.$i.2 [subst {
    btree_move_to $::c1 [format %03d $i]
    string range \[btree_data $::c1\] 0 10
  }] "*** [format %03d $i] ***"
}
do_test btree-9.4.1 {
  lindex [btree_pager_stats $::b1] 1
} {3}

# Check the page joining logic.
#
#btree_page_dump $::b1 2
#btree_pager_ref_dump $::b1
do_test btree-9.4.2 {
  btree_move_to $::c1 005
  btree_delete $::c1
} {}
#btree_page_dump $::b1 2
for {set i 1} {$i<=19} {incr i} {
  if {$i==5} continue
  do_test btree-9.5.$i.1 [subst {
    btree_move_to $::c1 [format %03d $i]
    btree_key $::c1
  }] [format %03d $i]
  do_test btree-9.5.$i.2 [subst {
    btree_move_to $::c1 [format %03d $i]
    string range \[btree_data $::c1\] 0 10
  }] "*** [format %03d $i] ***"
}
#btree_pager_ref_dump $::b1
do_test btree-9.6 {
  btree_close_cursor $::c1
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-9.7 {
  btree_rollback $::b1
  lindex [btree_pager_stats $::b1] 1
} {0}

# Create a tree of depth two.  That is, there is a single divider entry
# on the root pages and two leaf pages.  Then delete the divider entry
# see what happens.
#
do_test btree-10.1 {
  btree_begin_transaction $::b1
  btree_drop_table $::b1 2
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-10.2 {
  set ::c1 [btree_cursor $::b1 2]
  lindex [btree_pager_stats $::b1] 1
} {2}
do_test btree-10.3 {
  for {set i 1} {$i<=20} {incr i} {
    set key [format %03d $i]
    set data "*** $key *** $key *** $key *** $key ***"
    btree_insert $::c1 $key $data
  }
  select_keys $::c1
} {001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020}
#btree_page_dump $::b1 7
#btree_page_dump $::b1 2
#btree_page_dump $::b1 6
do_test btree-10.4 {
  btree_move_to $::c1 011
  btree_delete $::c1
  select_keys $::c1
} {001 002 003 004 005 006 007 008 009 010 012 013 014 015 016 017 018 019 020}
#btree_tree_dump $::b1 2
#btree_pager_ref_dump $::b1
for {set i 1} {$i<=20} {incr i} {
  do_test btree-10.5.$i {
    btree_move_to $::c1 [format %03d $i]
    lindex [btree_pager_stats $::b1] 1
  } {2}
  #btree_pager_ref_dump $::b1
  #btree_tree_dump $::b1 2
}

# Create a tree with lots more pages
#
catch {unset ::data}
catch {unset ::key}
for {set i 21} {$i<=1000} {incr i} {
  do_test btree-11.1.$i.1 {
    set key [format %03d $i]
    set ::data "*** $key *** $key *** $key *** $key ***"
    btree_insert $::c1 $key $data
    btree_key $::c1
  } [format %03d $i]
  do_test btree-11.1.$i.2 {
    btree_data $::c1
  } $::data
  set ::key [format %03d [expr {$i/2}]]
  if {$::key=="011"} {set ::key 010}
  do_test btree-11.1.$i.3 {
    btree_move_to $::c1 $::key
    btree_key $::c1
  } $::key
}
catch {unset ::data}
catch {unset ::key}

# Make sure our reference count is still correct.
#
do_test btree-11.2 {
  btree_close_cursor $::c1
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-11.3 {
  set ::c1 [btree_cursor $::b1 2]
  lindex [btree_pager_stats $::b1] 1
} {2}
#btree_page_dump $::b1 2

# Delete the dividers on the root page
#
do_test btree-11.4 {
  btree_move_to $::c1 257
  btree_delete $::c1
  btree_next $::c1
  btree_key $::c1
} {258}
do_test btree-11.4.1 {
  btree_move_to $::c1 256
  btree_key $::c1
} {256}
do_test btree-11.4.2 {
  btree_move_to $::c1 258
  btree_key $::c1
} {258}
do_test btree-11.4.3 {
  btree_move_to $::c1 259
  btree_key $::c1
} {259}
do_test btree-11.4.4 {
  btree_move_to $::c1 257
  set n [btree_key $::c1]
  expr {$n==256||$n==258}
} {1}
do_test btree-11.5 {
  btree_move_to $::c1 513
  btree_delete $::c1
  btree_next $::c1
  btree_key $::c1
} {514}
do_test btree-11.5.1 {
  btree_move_to $::c1 512
  btree_key $::c1
} {512}
do_test btree-11.5.2 {
  btree_move_to $::c1 514
  btree_key $::c1
} {514}
do_test btree-11.5.3 {
  btree_move_to $::c1 515
  btree_key $::c1
} {515}
do_test btree-11.5.4 {
  btree_move_to $::c1 513
  set n [btree_key $::c1]
  expr {$n==512||$n==514}
} {1}
do_test btree-11.6 {
  btree_move_to $::c1 769
  btree_delete $::c1
  btree_next $::c1
  btree_key $::c1
} {770}
do_test btree-11.6.1 {
  btree_move_to $::c1 768
  btree_key $::c1
} {768}
do_test btree-11.6.2 {
  btree_move_to $::c1 771
  btree_key $::c1
} {771}
do_test btree-11.6.3 {
  btree_move_to $::c1 770
  btree_key $::c1
} {770}
do_test btree-11.6.4 {
  btree_move_to $::c1 769
  set n [btree_key $::c1]
  expr {$n==768||$n==770}
} {1}
#btree_page_dump $::b1 2
#btree_page_dump $::b1 25

# Change the data on an intermediate node such that the node becomes overfull
# and has to split.  We happen to know that intermediate nodes exist on
# 337, 401 and 465 by the btree_page_dumps above
#
catch {unset ::data}
set ::data {This is going to be a very long data segment}
append ::data $::data
append ::data $::data
do_test btree-12.1 {
  btree_insert $::c1 337 $::data
  btree_data $::c1
} $::data
do_test btree-12.2 {
  btree_insert $::c1 401 $::data
  btree_data $::c1
} $::data
do_test btree-12.3 {
  btree_insert $::c1 465 $::data
  btree_data $::c1
} $::data
do_test btree-12.4 {
  btree_move_to $::c1 337
  btree_key $::c1
} {337}
do_test btree-12.5 {
  btree_data $::c1
} $::data
do_test btree-12.6 {
  btree_next $::c1
  btree_key $::c1
} {338}
do_test btree-12.7 {
  btree_move_to $::c1 464
  btree_key $::c1
} {464}
do_test btree-12.8 {
  btree_next $::c1
  btree_data $::c1
} $::data
do_test btree-12.9 {
  btree_next $::c1
  btree_key $::c1
} {466}
do_test btree-12.10 {
  btree_move_to $::c1 400
  btree_key $::c1
} {400}
do_test btree-12.11 {
  btree_next $::c1
  btree_data $::c1
} $::data
do_test btree-12.12 {
  btree_next $::c1
  btree_key $::c1
} {402}
do_test btree-13.1 {
  btree_sanity_check $::b1 2 3
} {}

# To Do:
#
#   1.  Do some deletes from the 3-layer tree
#   2.  Commit and reopen the database
#   3.  Read every 15th entry and make sure it works
#   4.  Implement btree_sanity and put it throughout this script
#

do_test btree-10.98 {
  btree_close_cursor $::c1
  lindex [btree_pager_stats $::b1] 1
} {1}
do_test btree-10.99 {
  btree_rollback $::b1
  lindex [btree_pager_stats $::b1] 1
} {0}
btree_pager_ref_dump $::b1

do_test btree-99.1 {
  btree_close $::b1
} {}
catch {unset data}
catch {unset key}

} ;# end if( not mem: and has pager_open command );

finish_test

# Copyright (c) 1999, 2000 D. Richard Hipp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# Author contact information:
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is btree database backend
#
# $Id: btree2.test,v 1.4 2001/08/20 00:33:58 drh Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl

if {[info commands btree_open]!=""} {

# Create a new database file containing no entries.  The database should
# contain 5 tables:
#
#     2   The descriptor table
#     3   The foreground table
#     4   The background table
#     5   The long key table
#     6   The long data table
#
# An explanation for what all these tables are used for is provided below.
#
do_test btree2-1.1 {
  expr srand(1)
  file delete -force test2.bt
  file delete -force test2.bt-journal
  set ::b [btree_open test2.bt]
  btree_begin_transaction $::b
  btree_create_table $::b
} {3}
do_test btree2-1.2 {
  btree_create_table $::b
} {4}
do_test btree2-1.3 {
  btree_create_table $::b
} {5}
do_test btree2-1.4 {
  btree_create_table $::b
} {6}
do_test btree2-1.5 {
  set ::c2 [btree_cursor $::b 2]
  btree_insert $::c2 {one} {1}
  btree_delete $::c2
  btree_close_cursor $::c2
  btree_commit $::b
  btree_sanity_check $::b 2 3 4 5 6
} {}

# This test module works by making lots of pseudo-random changes to a
# database while simultaneously maintaining an invariant on that database.
# Periodically, the script does a sanity check on the database and verifies
# that the invariant is satisfied.
#
# The invariant is as follows:
#
#   1.  The descriptor table always contains 2 enters.  An entry keyed by
#       "N" is the number of elements in the foreground and background tables
#       combined.  The entry keyed by "L" is the number of digits in the keys
#       for foreground and background tables.
#
#   2.  The union of the foreground an background tables consists of N entries
#       where each entry an L-digit key.  (Actually, some keys can be longer 
#       than L characters, but they always start with L digits.)  The keys
#       cover all integers between 1 and N.  Whenever an entry is added to
#       the foreground it is removed form the background and vice versa.
#
#   3.  Some entries in the foreground and background tables have keys that
#       begin with an L-digit number but are followed by additional characters.
#       For each such entry there is a corresponding entry in the long key
#       table.  The long key table entry has a key which is just the L-digit
#       number and data which is the length of the key in the foreground and
#       background tables.
#
#   4.  The data for both foreground and background entries is usually a
#       short string.  But some entries have long data strings.  For each
#       such entries there is an entry in the long data type.  The key to
#       long data table is an L-digit number.  (The extension on long keys
#       is omitted.)  The data is the number of charaters in the data of the
#       foreground or background entry.
#
# The following function builds a database that satisfies all of the above
# invariants.
#
proc build_db {N L} {
  for {set i 2} {$i<=6} {incr i} {
    catch {btree_close_cursor [set ::c$i]}
    btree_clear_table $::b $i
    set ::c$i [btree_cursor $::b $i]
  }
  btree_insert $::c2 N $N
  btree_insert $::c2 L $L
  set format %0${L}d
  for {set i 1} {$i<=$N} {incr i} { 
    set key [format $format $i]
    set data $key
    btree_insert $::c3 $key $data
  }
}

# Given a base key number and a length, construct the full text of the key
# or data.
#
proc make_payload {keynum L len} {
  set key [format %0${L}d $keynum]
  set r $key
  set i 1
  while {[string length $r]<$len} {
    append r " ($i) $key"
    incr i
  }
  return [string range $r 0 [expr {$len-1}]]
}

# Verify the invariants on the database.  Return an empty string on 
# success or an error message if something is amiss.
#
proc check_invariants {} {
  set ck [btree_sanity_check $::b 2 3 4 5 6]
  if {$ck!=""} {
    puts "\n*** SANITY:\n$ck"
    exit
    return $ck
  }
  btree_move_to $::c3 {}
  btree_move_to $::c4 {}
  btree_move_to $::c2 N
  set N [btree_data $::c2]
  btree_move_to $::c2 L
  set L [btree_data $::c2]
  set LM1 [expr {$L-1}]
  for {set i 1} {$i<=$N} {incr i} {
    set key [btree_key $::c3]
    if {[scan $key %d k]<1} {set k 0}
    if {$k!=$i} {
      set key [btree_key $::c4]
      if {[scan $key %d k]<1} {set k 0}
      if {$k!=$i} {
        # puts "MISSING $i"
        # puts {Page 3:}; btree_page_dump $::b 3
        # puts {Page 4:}; btree_page_dump $::b 4
        # exit
        return "Key $i is missing from both foreground and background"
      }
      set data [btree_data $::c4]
      btree_next $::c4
    } else {
      set data [btree_data $::c3]
      btree_next $::c3
    }
    set skey [string range $key 0 $LM1]
    if {[btree_move_to $::c5 $skey]==0} {
      set keylen [btree_data $::c5]
    } else {
      set keylen $L
    }
    if {[string length $key]!=$keylen} {
      return "Key $i is the wrong size.\
              Is \"$key\" but should be \"[make_payload $k $L $keylen]\""
    }
    if {[make_payload $k $L $keylen]!=$key} {
      return "Key $i has an invalid extension"
    }
    if {[btree_move_to $::c6 $skey]==0} {
      set datalen [btree_data $::c6]
    } else {
      set datalen $L
    }
    if {[string length $data]!=$datalen} {
      return "Data for $i is the wrong size.\
              Is [string length $data] but should be $datalen"
    }
    if {[make_payload $k $L $datalen]!=$data} {
      return "Entry $i has an incorrect data"
    }
  }
}

# Make random changes to the database such that each change preserves
# the invariants.  The number of changes is $n*N where N is the parameter
# from the descriptor table.  Each changes begins with a random key.
# the entry with that key is put in the foreground table with probability
# $I and it is put in background with probability (1.0-$I).  It gets
# a long key with probability $K and long data with probability $D.  
# 
set chngcnt 0
proc random_changes {n I K D} {
  btree_move_to $::c2 N
  set N [btree_data $::c2]
  btree_move_to $::c2 L
  set L [btree_data $::c2]
  set LM1 [expr {$L-1}]
  set total [expr {int($N*$n)}]
  set format %0${L}d
  for {set i 0} {$i<$total} {incr i} {
    set k [expr {int(rand()*$N)+1}]
    set insert [expr {rand()<=$I}]
    set longkey [expr {rand()<=$K}]
    set longdata [expr {rand()<=$D}]
    # incr ::chngcnt
    # if {$::chngcnt==251} {btree_tree_dump $::b 3} 
    # puts "CHANGE $::chngcnt: $k $insert $longkey $longdata"
    if {$longkey} {
      set x [expr {rand()}]
      set keylen [expr {int($x*$x*$x*$x*3000)+10}]
    } else {
      set keylen $L
    }
    set key [make_payload $k $L $keylen]
    if {$longdata} {
      set x [expr {rand()}]
      set datalen [expr {int($x*$x*$x*$x*3000)+10}]
    } else {
      set datalen $L
    }
    set data [make_payload $k $L $datalen]
    set basekey [format $format $k]
    if {[set c [btree_move_to $::c3 $basekey]]==0} {
      btree_delete $::c3
    } else {
      if {$c<0} {btree_next $::c3}
      if {[string match $basekey* [btree_key $::c3]]} {
        btree_delete $::c3
      }
    }
    if {[set c [btree_move_to $::c4 $basekey]]==0} {
      btree_delete $::c4
    } else {
      if {$c<0} {btree_next $::c4}
      if {[string match $basekey* [btree_key $::c4]]} {
        btree_delete $::c4
      }
    }
    if {[scan [btree_key $::c4] %d kx]<1} {set kx -1}
    if {$kx==$k} {
      btree_delete $::c4
    }
    if {$insert} {
      btree_insert $::c3 $key $data
    } else {
      btree_insert $::c4 $key $data
    }
    if {$longkey} {
      btree_insert $::c5 $basekey $keylen
    } elseif {[btree_move_to $::c5 $basekey]==0} {
      btree_delete $::c5
    }
    if {$longdata} {
      btree_insert $::c6 $basekey $datalen
    } elseif {[btree_move_to $::c6 $basekey]==0} {
      btree_delete $::c6
    }
    # set ck [btree_sanity_check $::b 2 3 4 5 6]
    # if {$ck!=""} {
    #   puts "\nSANITY CHECK FAILED!\n$ck"
    #   exit
    # }
    # puts "PAGE 3:"; btree_page_dump $::b 3
    # puts "PAGE 4:"; btree_page_dump $::b 4
  }
}

# Repeat this test sequence on database of various sizes
#
set testno 2
foreach {N L} {
  10 2
  50 2
  200 3
} {
#  2000 5
  puts "**** N=$N L=$L ****"
  set hash [md5file test2.bt]
  do_test btree2-$testno.1 [subst -nocommands {
    set ::c2 [btree_cursor $::b 2]
    set ::c3 [btree_cursor $::b 3]
    set ::c4 [btree_cursor $::b 4]
    set ::c5 [btree_cursor $::b 5]
    set ::c6 [btree_cursor $::b 6]
    btree_begin_transaction $::b
    build_db $N $L
    check_invariants
  }] {}
  do_test btree2-$testno.2 {
    btree_close_cursor $::c2
    btree_close_cursor $::c3
    btree_close_cursor $::c4
    btree_close_cursor $::c5
    btree_close_cursor $::c6
    btree_rollback $::b
    md5file test2.bt
  } $hash
  do_test btree2-$testno.3 [subst -nocommands {
    btree_begin_transaction $::b
    set ::c2 [btree_cursor $::b 2]
    set ::c3 [btree_cursor $::b 3]
    set ::c4 [btree_cursor $::b 4]
    set ::c5 [btree_cursor $::b 5]
    set ::c6 [btree_cursor $::b 6]
    build_db $N $L
    check_invariants
  }] {}
  do_test btree2-$testno.4 {
    btree_commit $::b
    check_invariants
  } {}
  do_test btree2-$testno.5  {
    lindex [btree_pager_stats $::b] 1
  } {6}
  do_test btree2-$testno.6  {
    btree_close_cursor $::c2
    btree_close_cursor $::c3
    btree_close_cursor $::c4
    btree_close_cursor $::c5
    btree_close_cursor $::c6
    lindex [btree_pager_stats $::b] 1
  } {0}
  do_test btree2-$testno.7 {
    btree_close $::b
    set ::b [btree_open test2.bt]
    set ::c2 [btree_cursor $::b 2]
    set ::c3 [btree_cursor $::b 3]
    set ::c4 [btree_cursor $::b 4]
    set ::c5 [btree_cursor $::b 5]
    set ::c6 [btree_cursor $::b 6]
    check_invariants
  } {}

  # For each database size, run various changes tests.
  #
  set num2 1
  foreach {n I K D} {
    0.5 0.5 0.1 0.1
    1.0 0.2 0.1 0.1
    1.0 0.8 0.1 0.1
    2.0 0.0 0.1 0.1
    2.0 1.0 0.1 0.1
    2.0 0.0 0.0 0.0
    2.0 1.0 0.0 0.0
  } {
    set testid btree2-$testno.8.$num2
    set cnt 6
    for {set i 2} {$i<=6} {incr i} {
      if {[lindex [btree_cursor_dump [set ::c$i]] 0]!=$i} {incr cnt}
    }
    do_test $testid.1 {
      btree_begin_transaction $::b
      lindex [btree_pager_stats $::b] 1
    } $cnt
    set hash [md5file test2.bt]
    # exec cp test2.bt test2.bt.bu1
    do_test $testid.2 [subst {
      random_changes $n $I $K $D
    }] {}
    do_test $testid.3 {
      check_invariants
    } {}
    do_test $testid.4 {
      btree_close_cursor $::c2
      btree_close_cursor $::c3
      btree_close_cursor $::c4
      btree_close_cursor $::c5
      btree_close_cursor $::c6
      btree_rollback $::b
      md5file test2.bt
    } $hash
    # exec cp test2.bt test2.bt.bu2
    btree_begin_transaction $::b
    set ::c2 [btree_cursor $::b 2]
    set ::c3 [btree_cursor $::b 3]
    set ::c4 [btree_cursor $::b 4]
    set ::c5 [btree_cursor $::b 5]
    set ::c6 [btree_cursor $::b 6]
    do_test $testid.5 [subst {
      random_changes $n $I $K $D
    }] {}
    do_test $testid.6 {
      check_invariants
    } {}
    do_test $testid.7 {
      btree_commit $::b
      check_invariants
    } {}
    set hash [md5file test2.bt]
    do_test $testid.8 {
      btree_close_cursor $::c2
      btree_close_cursor $::c3
      btree_close_cursor $::c4
      btree_close_cursor $::c5
      btree_close_cursor $::c6
      lindex [btree_pager_stats $::b] 1
    } {0}
    do_test $testid.9 {
      btree_close $::b
      set ::b [btree_open test2.bt]
      set ::c2 [btree_cursor $::b 2]
      set ::c3 [btree_cursor $::b 3]
      set ::c4 [btree_cursor $::b 4]
      set ::c5 [btree_cursor $::b 5]
      set ::c6 [btree_cursor $::b 6]
      check_invariants
    } {}
    incr num2
  }
  btree_close_cursor $::c2
  btree_close_cursor $::c3
  btree_close_cursor $::c4
  btree_close_cursor $::c5
  btree_close_cursor $::c6
  incr testno
}  

# Testing is complete.  Shut everything down.
#
do_test btree-999.1 {
  lindex [btree_pager_stats $::b] 1
} {0}
do_test btree-999.2 {
  btree_close $::b
} {}
do_test btree-999.3 {
  file delete -force test2.bt
  file exists test2.bt-journal
} {0}

} ;# end if( not mem: and has pager_open command );

finish_test

# Copyright (c) 1999, 2000 D. Richard Hipp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# Author contact information:
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is page cache subsystem.
#
# $Id: pager.test,v 1.8 2001/08/20 00:33:58 drh Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl

if {$dbprefix!="memory:" && [info commands pager_open]!=""} {

# Basic sanity check.  Open and close a pager.
#
do_test pager-1.0 {
  catch {file delete -force ptf1.db}
  catch {file delete -force ptf1.db-journal}
  set v [catch {
    set ::p1 [pager_open ptf1.db 10]
  } msg]
} {0}
do_test pager-1.1 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-1.2 {
  pager_pagecount $::p1
} {0}
do_test pager-1.3 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-1.4 {
  pager_close $::p1
} {}

# Try to write a few pages.
#
do_test pager-2.1 {
  set v [catch {
    set ::p1 [pager_open ptf1.db 10]
  } msg]
} {0}
do_test pager-2.2 {
  set v [catch {
    set ::g1 [page_get $::p1 0]
  } msg]
  lappend v $msg
} {1 SQLITE_ERROR}
do_test pager-2.3.1 {
  set ::gx [page_lookup $::p1 1]
} {}
do_test pager-2.3.2 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-2.3.3 {
  set v [catch {
    set ::g1 [page_get $::p1 1]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-2.3.3 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.3.4 {
  set ::gx [page_lookup $::p1 1]
  expr {$::gx!=""}
} {1}
do_test pager-2.3.5 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.3.6 {
  expr $::g1==$::gx
} {1}
do_test pager-2.3.7 {
  page_unref $::gx
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.4 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.5 {
  pager_pagecount $::p1
} {0}
do_test pager-2.6 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.7 {
  page_number $::g1
} {1}
do_test pager-2.8 {
  page_read $::g1
} {}
do_test pager-2.9 {
  page_unref $::g1
} {}
do_test pager-2.10 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.11 {
  set ::g1 [page_get $::p1 1]
  expr {$::g1!=0}
} {1}
do_test pager-2.12 {
  page_number $::g1
} {1}
do_test pager-2.13 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 2 ovfl 0}
do_test pager-2.14 {
  set v [catch {
    page_write $::g1 "Page-One"
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.15 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 1 state 2 err 0 hit 0 miss 2 ovfl 0}
do_test pager-2.16 {
  page_read $::g1
} {Page-One}
do_test pager-2.17 {
  set v [catch {
    pager_commit $::p1
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.20 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size -1 state 1 err 0 hit 0 miss 2 ovfl 0}
do_test pager-2.19 {
  pager_pagecount $::p1
} {1}
do_test pager-2.21 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 1 state 1 err 0 hit 0 miss 2 ovfl 0}
do_test pager-2.22 {
  page_unref $::g1
} {}
do_test pager-2.23 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 2 ovfl 0}
do_test pager-2.24 {
  set v [catch {
    page_get $::p1 1
  } ::g1]
  if {$v} {lappend v $::g1}
  set v
} {0}
do_test pager-2.25 {
  page_read $::g1
} {Page-One}
do_test pager-2.26 {
  set v [catch {
    page_write $::g1 {page-one}
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.27 {
  page_read $::g1
} {page-one}
do_test pager-2.28 {
  set v [catch {
    pager_rollback $::p1
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.29 {
  page_read $::g1
} {Page-One}
do_test pager-2.99 {
  pager_close $::p1
} {}

do_test pager-3.1 {
  set v [catch {
    set ::p1 [pager_open ptf1.db 15]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-3.2 {
  pager_pagecount $::p1
} {1}
do_test pager-3.3 {
  set v [catch {
    set ::g(1) [page_get $::p1 1]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-3.4 {
  page_read $::g(1)
} {Page-One}
do_test pager-3.5 {
  for {set i 2} {$i<=20} {incr i} {
    set gx [page_get $::p1 $i]
    page_write $gx "Page-$i"
    page_unref $gx
  }
  pager_commit $::p1
} {}
for {set i 2} {$i<=20} {incr i} {
  do_test pager-3.6.[expr {$i-1}] [subst {
    set gx \[page_get $::p1 $i\]
    set v \[page_read \$gx\]
    page_unref \$gx
    set v
  }] "Page-$i"
}
for {set i 1} {$i<=20} {incr i} {
  regsub -all CNT {
    set ::g1 [page_get $::p1 CNT]
    set ::g2 [page_get $::p1 CNT]
    set ::vx [page_read $::g2]
    expr {$::g1==$::g2}
  } $i body;
  do_test pager-3.7.$i.1 $body {1}
  regsub -all CNT {
    page_unref $::g2
    set vy [page_read $::g1]
    expr {$vy==$::vx}
  } $i body;
  do_test pager-3.7.$i.2 $body {1}
  regsub -all CNT {
    page_unref $::g1
    set gx [page_get $::p1 CNT]
    set vy [page_read $gx]
    page_unref $gx
    expr {$vy==$::vx}
  } $i body;
  do_test pager-3.7.$i.3 $body {1}
}
do_test pager-3.99 {
  pager_close $::p1
} {}


} ;# end if( not mem: and has pager_open command );

finish_test