SQLite

**    May you share freely, never taking more than you give.
**
*************************************************************************
**
** This file contains functions used to access the internal hash tables
** of user defined functions and collation sequences.
**
** $Id: callback.c,v 1.31 2008/09/09 12:31:34 drh Exp $
*/

#include "sqliteInt.h"

/*
** Invoke the 'collation needed' callback to request a collation sequence
** in the database text encoding of name zName, length nName.

  int h;              /* Hash value */


  assert( enc==SQLITE_UTF8 || enc==SQLITE_UTF16LE || enc==SQLITE_UTF16BE );
  if( nArg<-1 ) nArg = -1;
  h = (sqlite3UpperToLower[(u8)zName[0]] + nName) % ArraySize(db->aFunc.a);

  /* First search for a match amongst the application-defined functions.
  */
  p = functionSearch(&db->aFunc, h, zName, nName);
  while( p ){
    int score = matchQuality(p, nArg, enc);
    if( score>bestScore ){
      pBest = p;
      bestScore = score;
    }
    p = p->pNext;
  }

  /* If no match is found, search the built-in functions.
  **
  ** Except, if createFlag is true, that means that we are trying to
  ** install a new function.  Whatever FuncDef structure is returned will
  ** have fields overwritten with new information appropriate for the
  ** new function.  But the FuncDefs for built-in functions are read-only.
  ** So we must not search for built-ins when creating a new function.
  */ 
  if( !createFlag && !pBest ){
    FuncDefHash *pHash = &GLOBAL(FuncDefHash, sqlite3GlobalFunctions);
    p = functionSearch(pHash, h, zName, nName);
    while( p ){
      int score = matchQuality(p, nArg, enc);
      if( score>bestScore ){
        pBest = p;
        bestScore = score;
      }
      p = p->pNext;
    }
  }

  /* If the createFlag parameter is true and the search did not reveal an
  ** exact match for the name, number of arguments and encoding, then add a
  ** new entry to the hash table and return it.
  */
  if( createFlag && (bestScore<6 || pBest->nArg!=nArg) && 
      (pBest = sqlite3DbMallocZero(db, sizeof(*pBest)+nName+1))!=0 ){
    pBest->zName = (char *)&pBest[1];
    pBest->nArg = nArg;
    pBest->iPrefEnc = enc;
    memcpy(pBest->zName, zName, nName);
    pBest->zName[nName] = 0;
    sqlite3FuncDefInsert(&db->aFunc, pBest);

**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite.  Append this file to sqlite3.c and
** compile the whole thing to build a TCL-enabled version of SQLite.
**
** $Id: tclsqlite.c,v 1.224 2008/09/09 12:31:34 drh Exp $
*/
#include "tcl.h"
#include <errno.h>

/*
** Some additional include files are needed if this file is not
** appended to the amalgamation.

    }else if( rc==TCL_OK ){
      Tcl_ResetResult(interp);
    }
    break;
  }

  /*
  **     $db function NAME [-argcount N] SCRIPT
  **
  ** Create a new SQL function called NAME.  Whenever that function is
  ** called, invoke SCRIPT to evaluate the function.
  */
  case DB_FUNCTION: {
    SqlFunc *pFunc;
    Tcl_Obj *pScript;
    char *zName;
    int nArg = -1;
    if( objc==6 ){
      const char *z = Tcl_GetString(objv[3]);
      int n = strlen(z);
      if( n>2 && strncmp(z, "-argcount",n)==0 ){
        if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR;
        if( nArg<0 ){
          Tcl_AppendResult(interp, "number of arguments must be non-negative",
                           (char*)0);
          return TCL_ERROR;
        }
      }
      pScript = objv[5];
    }else if( objc!=4 ){
      Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT");
      return TCL_ERROR;
    }else{
      pScript = objv[3];
    }
    zName = Tcl_GetStringFromObj(objv[2], 0);

    pFunc = findSqlFunc(pDb, zName);
    if( pFunc==0 ) return TCL_ERROR;
    if( pFunc->pScript ){
      Tcl_DecrRefCount(pFunc->pScript);
    }
    pFunc->pScript = pScript;
    Tcl_IncrRefCount(pScript);
    pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
    rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8,
        pFunc, tclSqlFunc, 0, 0);
    if( rc!=SQLITE_OK ){
      rc = TCL_ERROR;
      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
    }
    break;
  }

#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this file is testing the LIKE and GLOB operators and
# in particular the optimizations that occur to help those operators
# run faster.
#
# $Id: like.test,v 1.10 2008/09/09 12:31:34 drh Exp $

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

# Create some sample data to work with.
#
do_test like-1.0 {

# Tests of the MATCH operator
#
do_test like-2.3 {
  proc test_match {a b} {
    return [string match $a $b]
  }
  db function match -argcount 2 test_match
  execsql {
    SELECT x FROM t1 WHERE x MATCH '*abc*' ORDER BY 1;
  }
} {{ABC abc xyz} abc abcd}
do_test like-2.4 {
  execsql {
    SELECT x FROM t1 WHERE x MATCH 'abc*' ORDER BY 1;

} {'abc 'ax}

do_test like-7.1 {
  execsql {
    SELECT * FROM t1 WHERE rowid GLOB '1*';
  }
} {a}

# ticket #3345.
#
# Overloading the LIKE function with -1 for the number of arguments
# will overload both the 2-argument and the 3-argument LIKE.
#
do_test like-8.1 {
  db eval {
    CREATE TABLE t8(x);
    INSERT INTO t8 VALUES('abcdef');
    INSERT INTO t8 VALUES('ghijkl');
    INSERT INTO t8 VALUES('mnopqr');
    SELECT 1, x FROM t8 WHERE x LIKE '%h%';
    SELECT 2, x FROM t8 WHERE x LIKE '%h%' ESCAPE 'x';
  }
} {1 ghijkl 2 ghijkl}
do_test like-8.2 {
  proc newlike {args} {return 1} ;# Alternative LIKE is always return TRUE
  db function like newlike       ;# Uses -1 for nArg in sqlite3_create_function
  db cache flush
  db eval {
    SELECT 1, x FROM t8 WHERE x LIKE '%h%';
    SELECT 2, x FROM t8 WHERE x LIKE '%h%' ESCAPE 'x';
  }
} {1 ghijkl 2 ghijkl}
do_test like-8.3 {
  db function like -argcount 2 newlike
  db eval {
    SELECT 1, x FROM t8 WHERE x LIKE '%h%';
    SELECT 2, x FROM t8 WHERE x LIKE '%h%' ESCAPE 'x';
  }
} {1 abcdef 1 ghijkl 1 mnopqr 2 ghijkl}
do_test like-8.4 {
  db function like -argcount 3 newlike
  db eval {
    SELECT 1, x FROM t8 WHERE x LIKE '%h%';
    SELECT 2, x FROM t8 WHERE x LIKE '%h%' ESCAPE 'x';
  }
} {1 abcdef 1 ghijkl 1 mnopqr 2 abcdef 2 ghijkl 2 mnopqr}


finish_test

# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.69 2008/09/09 12:31:34 drh Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {

do_test tcl-1.14 {
  set v [catch {db eval} msg]
  lappend v $msg
} {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}
do_test tcl-1.15 {
  set v [catch {db function} msg]
  lappend v $msg
} {1 {wrong # args: should be "db function NAME [-argcount N] SCRIPT"}}
do_test tcl-1.16 {
  set v [catch {db last_insert_rowid xyz} msg]
  lappend v $msg
} {1 {wrong # args: should be "db last_insert_rowid "}}
do_test tcl-1.17 {
  set v [catch {db rekey} msg]
  lappend v $msg