/ Check-in [789a492b]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add the "-returntype" option to the "db function" Tcl method.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 789a492b68c353e2b763d67d399722b7ab61bfe09b472466df2821f65cab1be9
User & Date: dan 2019-02-27 16:38:19
Context
2019-02-27
19:59
Fix the readfile() UDF so that it returns an empty BLOB, not an OOM error, when reading an empty file. check-in: 0edad533 user: drh tags: trunk
16:38
Add the "-returntype" option to the "db function" Tcl method. check-in: 789a492b user: dan tags: trunk
15:26
Verify that fts5 auxiliary functions cannot be used in aggregate queries. check-in: 122330db user: dan tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

    89     89   
    90     90   /* Forward declaration */
    91     91   typedef struct SqliteDb SqliteDb;
    92     92   
    93     93   /*
    94     94   ** New SQL functions can be created as TCL scripts.  Each such function
    95     95   ** is described by an instance of the following structure.
           96  +**
           97  +** Variable eType may be set to SQLITE_INTEGER, SQLITE_FLOAT, SQLITE_TEXT,
           98  +** SQLITE_BLOB or SQLITE_NULL. If it is SQLITE_NULL, then the implementation
           99  +** attempts to determine the type of the result based on the Tcl object.
          100  +** If it is SQLITE_TEXT or SQLITE_BLOB, then a text (sqlite3_result_text())
          101  +** or blob (sqlite3_result_blob()) is returned. If it is SQLITE_INTEGER
          102  +** or SQLITE_FLOAT, then an attempt is made to return an integer or float
          103  +** value, falling back to float and then text if this is not possible.
    96    104   */
    97    105   typedef struct SqlFunc SqlFunc;
    98    106   struct SqlFunc {
    99    107     Tcl_Interp *interp;   /* The TCL interpret to execute the function */
   100    108     Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
   101    109     SqliteDb *pDb;        /* Database connection that owns this function */
   102    110     int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
          111  +  int eType;            /* Type of value to return */
   103    112     char *zName;          /* Name of this function */
   104    113     SqlFunc *pNext;       /* Next function on the list of them all */
   105    114   };
   106    115   
   107    116   /*
   108    117   ** New collation sequences function can be created as TCL scripts.  Each such
   109    118   ** function is described by an instance of the following structure.
................................................................................
   991   1000       sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
   992   1001     }else{
   993   1002       Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
   994   1003       int n;
   995   1004       u8 *data;
   996   1005       const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
   997   1006       char c = zType[0];
   998         -    if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
   999         -      /* Only return a BLOB type if the Tcl variable is a bytearray and
  1000         -      ** has no string representation. */
  1001         -      data = Tcl_GetByteArrayFromObj(pVar, &n);
  1002         -      sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
  1003         -    }else if( c=='b' && strcmp(zType,"boolean")==0 ){
  1004         -      Tcl_GetIntFromObj(0, pVar, &n);
  1005         -      sqlite3_result_int(context, n);
  1006         -    }else if( c=='d' && strcmp(zType,"double")==0 ){
  1007         -      double r;
  1008         -      Tcl_GetDoubleFromObj(0, pVar, &r);
  1009         -      sqlite3_result_double(context, r);
  1010         -    }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
  1011         -          (c=='i' && strcmp(zType,"int")==0) ){
  1012         -      Tcl_WideInt v;
  1013         -      Tcl_GetWideIntFromObj(0, pVar, &v);
  1014         -      sqlite3_result_int64(context, v);
  1015         -    }else{
  1016         -      data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
  1017         -      sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
  1018         -    }
         1007  +    int eType = p->eType;
         1008  +
         1009  +    if( eType==SQLITE_NULL ){
         1010  +      if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
         1011  +        /* Only return a BLOB type if the Tcl variable is a bytearray and
         1012  +        ** has no string representation. */
         1013  +        eType = SQLITE_BLOB;
         1014  +      }else if( (c=='b' && strcmp(zType,"boolean")==0)
         1015  +             || (c=='w' && strcmp(zType,"wideInt")==0)
         1016  +             || (c=='i' && strcmp(zType,"int")==0) 
         1017  +      ){
         1018  +        eType = SQLITE_INTEGER;
         1019  +      }else if( c=='d' && strcmp(zType,"double")==0 ){
         1020  +        eType = SQLITE_FLOAT;
         1021  +      }else{
         1022  +        eType = SQLITE_TEXT;
         1023  +      }
         1024  +    }
         1025  +
         1026  +    switch( eType ){
         1027  +      case SQLITE_BLOB: {
         1028  +        data = Tcl_GetByteArrayFromObj(pVar, &n);
         1029  +        sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
         1030  +        break;
         1031  +      }
         1032  +      case SQLITE_INTEGER: {
         1033  +        Tcl_WideInt v;
         1034  +        if( TCL_OK==Tcl_GetWideIntFromObj(0, pVar, &v) ){
         1035  +          sqlite3_result_int64(context, v);
         1036  +          break;
         1037  +        }
         1038  +        /* fall-through */
         1039  +      }
         1040  +      case SQLITE_FLOAT: {
         1041  +        double r;
         1042  +        if( TCL_OK==Tcl_GetDoubleFromObj(0, pVar, &r) ){
         1043  +          sqlite3_result_double(context, r);
         1044  +          break;
         1045  +        }
         1046  +        /* fall-through */
         1047  +      }
         1048  +      default: {
         1049  +        data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
         1050  +        sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
         1051  +        break;
         1052  +      }
         1053  +    }
         1054  +
  1019   1055     }
  1020   1056   }
  1021   1057   
  1022   1058   #ifndef SQLITE_OMIT_AUTHORIZATION
  1023   1059   /*
  1024   1060   ** This is the authentication function.  It appends the authentication
  1025   1061   ** type code and the two arguments to zCmd[] then invokes the result
................................................................................
  2642   2678     case DB_FUNCTION: {
  2643   2679       int flags = SQLITE_UTF8;
  2644   2680       SqlFunc *pFunc;
  2645   2681       Tcl_Obj *pScript;
  2646   2682       char *zName;
  2647   2683       int nArg = -1;
  2648   2684       int i;
         2685  +    int eType = SQLITE_NULL;
  2649   2686       if( objc<4 ){
  2650   2687         Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
  2651   2688         return TCL_ERROR;
  2652   2689       }
  2653   2690       for(i=3; i<(objc-1); i++){
  2654   2691         const char *z = Tcl_GetString(objv[i]);
  2655   2692         int n = strlen30(z);
  2656         -      if( n>2 && strncmp(z, "-argcount",n)==0 ){
         2693  +      if( n>1 && strncmp(z, "-argcount",n)==0 ){
  2657   2694           if( i==(objc-2) ){
  2658   2695             Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
  2659   2696             return TCL_ERROR;
  2660   2697           }
  2661   2698           if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
  2662   2699           if( nArg<0 ){
  2663   2700             Tcl_AppendResult(interp, "number of arguments must be non-negative",
  2664   2701                              (char*)0);
  2665   2702             return TCL_ERROR;
  2666   2703           }
  2667   2704           i++;
  2668   2705         }else
  2669         -      if( n>2 && strncmp(z, "-deterministic",n)==0 ){
         2706  +      if( n>1 && strncmp(z, "-deterministic",n)==0 ){
  2670   2707           flags |= SQLITE_DETERMINISTIC;
         2708  +      }else
         2709  +      if( n>1 && strncmp(z, "-returntype", n)==0 ){
         2710  +        const char *azType[] = {"integer", "real", "text", "blob", "any", 0};
         2711  +        assert( SQLITE_INTEGER==1 && SQLITE_FLOAT==2 && SQLITE_TEXT==3 );
         2712  +        assert( SQLITE_BLOB==4 && SQLITE_NULL==5 );
         2713  +        if( i==(objc-2) ){
         2714  +          Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
         2715  +          return TCL_ERROR;
         2716  +        }
         2717  +        i++;
         2718  +        if( Tcl_GetIndexFromObj(interp, objv[i], azType, "type", 0, &eType) ){
         2719  +          return TCL_ERROR;
         2720  +        }
         2721  +        eType++;
  2671   2722         }else{
  2672   2723           Tcl_AppendResult(interp, "bad option \"", z,
  2673         -            "\": must be -argcount or -deterministic", (char*)0
         2724  +            "\": must be -argcount, -deterministic or -returntype", (char*)0
  2674   2725           );
  2675   2726           return TCL_ERROR;
  2676   2727         }
  2677   2728       }
  2678   2729   
  2679   2730       pScript = objv[objc-1];
  2680   2731       zName = Tcl_GetStringFromObj(objv[2], 0);
................................................................................
  2682   2733       if( pFunc==0 ) return TCL_ERROR;
  2683   2734       if( pFunc->pScript ){
  2684   2735         Tcl_DecrRefCount(pFunc->pScript);
  2685   2736       }
  2686   2737       pFunc->pScript = pScript;
  2687   2738       Tcl_IncrRefCount(pScript);
  2688   2739       pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
         2740  +    pFunc->eType = eType;
  2689   2741       rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
  2690   2742           pFunc, tclSqlFunc, 0, 0);
  2691   2743       if( rc!=SQLITE_OK ){
  2692   2744         rc = TCL_ERROR;
  2693   2745         Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
  2694   2746       }
  2695   2747       break;

Changes to test/tclsqlite.test.

    17     17   #
    18     18   # $Id: tclsqlite.test,v 1.73 2009/03/16 13:19:36 danielk1977 Exp $
    19     19   
    20     20   catch {sqlite3}
    21     21   
    22     22   set testdir [file dirname $argv0]
    23     23   source $testdir/tester.tcl
           24  +set testprefix tcl
    24     25   
    25     26   # Check the error messages generated by tclsqlite
    26     27   #
    27     28   set r "sqlite_orig HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
    28     29   if {[sqlite3 -has-codec]} {
    29     30     append r " ?-key CODECKEY?"
    30     31   }
................................................................................
   707    708     unset -nocomplain x
   708    709     db eval -withoutnulls {SELECT * FROM t1} x {
   709    710       lappend res $x(a) [array names x]
   710    711     }
   711    712     set res
   712    713   } {1 {a b *} 2 {a *} 3 {a b *}}
   713    714   
          715  +#-------------------------------------------------------------------------
          716  +# Test the -type option to [db function].
          717  +#
          718  +reset_db
          719  +proc add {a b} { return [expr $a + $b] }
          720  +proc ret {a} { return $a }
          721  +
          722  +db function add_i -returntype integer add 
          723  +db function add_r -ret        real    add
          724  +db function add_t -return     text    add 
          725  +db function add_b -returntype blob    add 
          726  +db function add_a -returntype any     add 
          727  +
          728  +db function ret_i -returntype int     ret 
          729  +db function ret_r -returntype real    ret
          730  +db function ret_t -returntype text    ret 
          731  +db function ret_b -returntype blob    ret 
          732  +db function ret_a -r          any     ret 
          733  +
          734  +do_execsql_test 17.0 {
          735  +  SELECT quote( add_i(2, 3) );
          736  +  SELECT quote( add_r(2, 3) ); 
          737  +  SELECT quote( add_t(2, 3) ); 
          738  +  SELECT quote( add_b(2, 3) ); 
          739  +  SELECT quote( add_a(2, 3) ); 
          740  +} {5 5.0 '5' X'35' 5}
          741  +
          742  +do_execsql_test 17.1 {
          743  +  SELECT quote( add_i(2.2, 3.3) );
          744  +  SELECT quote( add_r(2.2, 3.3) ); 
          745  +  SELECT quote( add_t(2.2, 3.3) ); 
          746  +  SELECT quote( add_b(2.2, 3.3) ); 
          747  +  SELECT quote( add_a(2.2, 3.3) ); 
          748  +} {5.5 5.5 '5.5' X'352E35' 5.5}
          749  +
          750  +do_execsql_test 17.2 {
          751  +  SELECT quote( ret_i(2.5) );
          752  +  SELECT quote( ret_r(2.5) ); 
          753  +  SELECT quote( ret_t(2.5) ); 
          754  +  SELECT quote( ret_b(2.5) ); 
          755  +  SELECT quote( ret_a(2.5) ); 
          756  +} {2.5 2.5 '2.5' X'322E35' 2.5}
          757  +
          758  +do_execsql_test 17.3 {
          759  +  SELECT quote( ret_i('2.5') );
          760  +  SELECT quote( ret_r('2.5') ); 
          761  +  SELECT quote( ret_t('2.5') ); 
          762  +  SELECT quote( ret_b('2.5') ); 
          763  +  SELECT quote( ret_a('2.5') ); 
          764  +} {2.5 2.5 '2.5' X'322E35' '2.5'}
          765  +
          766  +do_execsql_test 17.4 {
          767  +  SELECT quote( ret_i('abc') );
          768  +  SELECT quote( ret_r('abc') ); 
          769  +  SELECT quote( ret_t('abc') ); 
          770  +  SELECT quote( ret_b('abc') ); 
          771  +  SELECT quote( ret_a('abc') ); 
          772  +} {'abc' 'abc' 'abc' X'616263' 'abc'}
          773  +
          774  +do_execsql_test 17.5 {
          775  +  SELECT quote( ret_i(X'616263') );
          776  +  SELECT quote( ret_r(X'616263') ); 
          777  +  SELECT quote( ret_t(X'616263') ); 
          778  +  SELECT quote( ret_b(X'616263') ); 
          779  +  SELECT quote( ret_a(X'616263') ); 
          780  +} {'abc' 'abc' 'abc' X'616263' X'616263'}
          781  +
          782  +do_test 17.6.1 {
          783  +  list [catch { db function xyz -return object ret } msg] $msg
          784  +} {1 {bad type "object": must be integer, real, text, blob, or any}}
   714    785   
          786  +do_test 17.6.2 {
          787  +  list [catch { db function xyz -return ret } msg] $msg
          788  +} {1 {option requires an argument: -return}}
   715    789   
   716         -
          790  +do_test 17.6.3 {
          791  +  list [catch { db function xyz -n object ret } msg] $msg
          792  +} {1 {bad option "-n": must be -argcount, -deterministic or -returntype}}
   717    793   
   718    794   finish_test
          795  +