소스 검색

bindings: add SQLite callback support

Eric Streit 1 일 전
부모
커밋
9df09ae88d
5개의 변경된 파일과 496개의 추가작업 그리고 9개의 파일을 삭제
  1. 40 7
      bindings/sqlite3/README.md
  2. 74 2
      bindings/sqlite3/SQLite.def
  3. 1 0
      bindings/sqlite3/run.sh
  4. 373 0
      bindings/sqlite3/tests/SQLiteCallback.mod
  5. 8 0
      runtime/syslib/shim.c

+ 40 - 7
bindings/sqlite3/README.md

@@ -1,8 +1,9 @@
 # SQLite binding (core slice)
 
 This is a small, hand-written V3 binding for the core SQLite API:
-scalar values, BLOBs, prepared statements and connection control.  It
-is not a replacement for the full `m2SQLITE` definition.
+scalar values, BLOBs, prepared statements, connection control and
+callbacks.  It is not a replacement for the full `m2SQLITE`
+definition.
 
 ## Current surface
 
@@ -62,15 +63,37 @@ sqlite3_blob_write
 sqlite3_blob_bytes
 sqlite3_blob_reopen
 
-(* binding helper *)
+(* callbacks and user-defined scalar functions *)
+sqlite3_create_function_v2
+sqlite3_value_type
+sqlite3_value_int
+sqlite3_value_int64
+sqlite3_value_double
+sqlite3_value_text
+sqlite3_value_blob
+sqlite3_value_bytes
+sqlite3_result_null
+sqlite3_result_int
+sqlite3_result_int64
+sqlite3_result_double
+sqlite3_result_text
+sqlite3_result_blob
+sqlite3_result_error
+sqlite3_result_error_code
+sqlite3_user_data
+sqlite3_context_db_handle
+
+(* binding helpers *)
+SQLiteArrayAt
 SQLiteTransient
 ```
 
 The matching constants include the primary result codes
 (`SQLiteOk`, `SQLiteConstraint`, ...), `SQLiteRow`, `SQLiteDone`,
 storage classes (`SQLiteInteger`, `SQLiteFloat`, `SQLiteText`,
-`SQLiteBlob`, `SQLiteNull`), a few extended constraints and the
-`SQLiteOpen*` flags used by `sqlite3_open_v2` and `sqlite3_blob_open`.
+`SQLiteBlob`, `SQLiteNull`), a few extended constraints, the
+`SQLiteOpen*` flags used by `sqlite3_open_v2` and `sqlite3_blob_open`,
+and `SQLiteUtf*` / `SQLiteDeterministic` for function registration.
 
 ## Tests and showcase
 
@@ -82,6 +105,7 @@ storage classes (`SQLiteInteger`, `SQLiteFloat`, `SQLiteText`,
 - `SQLiteErrors.mod` - error codes, errmsg/errstr and `sqlite3_free`
 - `SQLiteBlob.mod` - bind_blob, bind_zeroblob, column_blob and incremental BLOB I/O
 - `SQLiteConnection.mod` - open_v2, close_v2, changes/rowid and deferred close
+- `SQLiteCallback.mod` - exec row callbacks and user-defined scalar functions
 - `showcase/SQLiteShowcase.mod` - prepared-statement walkthrough
 
 The showcase prints:
@@ -125,6 +149,14 @@ without `libsqlite3-dev`.
 - `sqlite3_blob_open` needs an explicit `SQLiteOpenReadOnly` or
   `SQLiteOpenReadWrite` flag.  A BLOB handle holds a read/write lock on
   its row until `sqlite3_blob_close`.
+- SQLite callbacks must be top-level V3 procedures: they are C-callable,
+  while nested procedures still carry a hidden frame link.
+- `sqlite3_exec` callbacks receive `char **argv` and `char **colNames`
+  as `ADDRESS`; use `SQLiteArrayAt(argv, i)` and
+  `SQLiteArrayAt(colNames, i)` to reach each entry.
+- User-defined functions receive `sqlite3_value **argv` as `ADDRESS`;
+  pass each `SQLiteArrayAt(argv, i)` result to `sqlite3_value_*` or
+  `sqlite3_result_*`.
 - When extended result codes are enabled, `sqlite3_exec` and
   `sqlite3_errcode` can report an extended code such as
   `SQLiteConstraintPrimaryKey` (1555) rather than only
@@ -132,5 +164,6 @@ without `libsqlite3-dev`.
 
 ## Still to add
 
-Callbacks, backup, extension loading, WAL/checkpoint helpers, connection
-configuration and statement parameter introspection.
+Remaining callback hooks (busy handler, authorizer, progress handler,
+trace/update hooks), backup, extension loading, WAL/checkpoint helpers,
+connection configuration and statement parameter introspection.

+ 74 - 2
bindings/sqlite3/SQLite.def

@@ -1,7 +1,8 @@
 DEFINITION MODULE FOR "C" SQLite;
 (* Core SQLite binding: connection setup, prepared statements,
    scalar/BLOB binding and results, column metadata, row changes,
-   incremental BLOB I/O and error reporting.
+   incremental BLOB I/O, error reporting, exec callbacks and
+   user-defined scalar functions.
    The full binding stays in m2SQLITE for later porting. *)
 
 FROM SYSTEM IMPORT ADDRESS;
@@ -21,6 +22,8 @@ EXPORT UNQUALIFIED
   SQLiteOpenURI, SQLiteOpenMemory, SQLiteOpenNoMutex,
   SQLiteOpenFullMutex, SQLiteOpenSharedCache, SQLiteOpenPrivateCache,
   SQLiteOpenWal,
+  SQLiteUtf8, SQLiteUtf16Le, SQLiteUtf16Be, SQLiteUtf16, SQLiteAny,
+  SQLiteDeterministic,
   sqlite3_open,
   sqlite3_open_v2,
   sqlite3_exec,
@@ -58,12 +61,31 @@ EXPORT UNQUALIFIED
   sqlite3_blob_write,
   sqlite3_blob_bytes,
   sqlite3_blob_reopen,
+  sqlite3_create_function_v2,
+  sqlite3_value_type,
+  sqlite3_value_int,
+  sqlite3_value_int64,
+  sqlite3_value_double,
+  sqlite3_value_text,
+  sqlite3_value_blob,
+  sqlite3_value_bytes,
+  sqlite3_result_null,
+  sqlite3_result_int,
+  sqlite3_result_int64,
+  sqlite3_result_double,
+  sqlite3_result_text,
+  sqlite3_result_blob,
+  sqlite3_result_error,
+  sqlite3_result_error_code,
+  sqlite3_user_data,
+  sqlite3_context_db_handle,
   sqlite3_errmsg,
   sqlite3_errstr,
   sqlite3_errcode,
   sqlite3_extended_errcode,
   sqlite3_extended_result_codes,
   sqlite3_free,
+  SQLiteArrayAt,
   SQLiteTransient;
 
 CONST
@@ -119,6 +141,13 @@ CONST
   SQLiteOpenPrivateCache = 262144;
   SQLiteOpenWal = 524288;
 
+  SQLiteUtf8 = 1;
+  SQLiteUtf16Le = 2;
+  SQLiteUtf16Be = 3;
+  SQLiteUtf16 = 4;
+  SQLiteAny = 5;
+  SQLiteDeterministic = 2048;
+
 PROCEDURE sqlite3_open (filename : ARRAY OF CHAR;
                         VAR db : ADDRESS) : INTEGER;
 PROCEDURE sqlite3_open_v2 (filename : ARRAY OF CHAR;
@@ -209,6 +238,45 @@ PROCEDURE sqlite3_blob_bytes (blob : ADDRESS) : INTEGER;
 PROCEDURE sqlite3_blob_reopen (blob : ADDRESS;
                                rowid : LONGINT) : INTEGER;
 
+(* User-defined scalar functions.  xFunc receives
+   (sqlite3_context*, int argc, sqlite3_value** argv); use
+   SQLiteArrayAt(argv, i) to reach each value. *)
+PROCEDURE sqlite3_create_function_v2 (db : ADDRESS;
+                                      name : ARRAY OF CHAR;
+                                      nArgs : INTEGER;
+                                      textRep : INTEGER;
+                                      userData : ADDRESS;
+                                      xFunc, xStep, xFinal : ADDRESS;
+                                      xDestroy : ADDRESS) : INTEGER;
+
+PROCEDURE sqlite3_value_type (value : ADDRESS) : INTEGER;
+PROCEDURE sqlite3_value_int (value : ADDRESS) : INTEGER;
+PROCEDURE sqlite3_value_int64 (value : ADDRESS) : LONGINT;
+PROCEDURE sqlite3_value_double (value : ADDRESS) : REAL;
+PROCEDURE sqlite3_value_text (value : ADDRESS) : CString;
+PROCEDURE sqlite3_value_blob (value : ADDRESS) : ADDRESS;
+PROCEDURE sqlite3_value_bytes (value : ADDRESS) : INTEGER;
+
+PROCEDURE sqlite3_result_null (ctx : ADDRESS);
+PROCEDURE sqlite3_result_int (ctx : ADDRESS; value : INTEGER);
+PROCEDURE sqlite3_result_int64 (ctx : ADDRESS; value : LONGINT);
+PROCEDURE sqlite3_result_double (ctx : ADDRESS; value : REAL);
+PROCEDURE sqlite3_result_text (ctx : ADDRESS;
+                               value : ARRAY OF CHAR;
+                               nBytes : INTEGER;
+                               destructor : ADDRESS);
+PROCEDURE sqlite3_result_blob (ctx : ADDRESS;
+                               data : ADDRESS;
+                               nBytes : INTEGER;
+                               destructor : ADDRESS);
+PROCEDURE sqlite3_result_error (ctx : ADDRESS;
+                                msg : ARRAY OF CHAR;
+                                nBytes : INTEGER);
+PROCEDURE sqlite3_result_error_code (ctx : ADDRESS; code : INTEGER);
+
+PROCEDURE sqlite3_user_data (ctx : ADDRESS) : ADDRESS;
+PROCEDURE sqlite3_context_db_handle (ctx : ADDRESS) : ADDRESS;
+
 PROCEDURE sqlite3_errmsg (db : ADDRESS) : CString;
 PROCEDURE sqlite3_errstr (code : INTEGER) : CString;
 PROCEDURE sqlite3_errcode (db : ADDRESS) : INTEGER;
@@ -217,8 +285,12 @@ PROCEDURE sqlite3_extended_result_codes (db : ADDRESS;
                                          onoff : INTEGER) : INTEGER;
 PROCEDURE sqlite3_free (p : ADDRESS);
 
+PROCEDURE SQLiteArrayAt (array : ADDRESS; idx : INTEGER) : ADDRESS;
+  EXTERNAL "m2_sqlite_array_at";
+(* Index a C array of pointers, such as char **argv or sqlite3_value **. *)
+
 PROCEDURE SQLiteTransient () : ADDRESS;
   EXTERNAL "m2_sqlite_transient";
-(* The SQLITE_TRANSIENT destructor sentinel: SQLite copies bound text. *)
+(* The SQLITE_TRANSIENT destructor sentinel: SQLite copies bound data. *)
 
 END SQLite.

+ 1 - 0
bindings/sqlite3/run.sh

@@ -42,4 +42,5 @@ build_and_run SQLiteScalar
 build_and_run SQLiteErrors
 build_and_run SQLiteBlob
 build_and_run SQLiteConnection
+build_and_run SQLiteCallback
 build_and_run SQLiteShowcase showcase/SQLiteShowcase.mod

+ 373 - 0
bindings/sqlite3/tests/SQLiteCallback.mod

@@ -0,0 +1,373 @@
+MODULE SQLiteCallback;
+(* Callback support:
+   sqlite3_exec row callbacks, scalar SQL functions and the
+   sqlite3_value_* / sqlite3_result_* families. *)
+
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM CStr IMPORT CString, Copy;
+FROM SQLite IMPORT
+  SQLiteOk, SQLiteRow, SQLiteDone, SQLiteAbort,
+  SQLiteInteger, SQLiteFloat, SQLiteText, SQLiteBlob, SQLiteNull,
+  SQLiteUtf8, SQLiteDeterministic,
+  SQLiteOpenReadWrite, SQLiteOpenCreate, SQLiteOpenMemory,
+  sqlite3_open_v2, sqlite3_exec, sqlite3_close_v2,
+  sqlite3_prepare_v2, sqlite3_step,
+  sqlite3_column_int, sqlite3_column_int64, sqlite3_column_double,
+  sqlite3_column_text, sqlite3_finalize,
+  sqlite3_errmsg, sqlite3_free,
+  sqlite3_create_function_v2,
+  sqlite3_value_type, sqlite3_value_int, sqlite3_value_int64,
+  sqlite3_value_double, sqlite3_value_text, sqlite3_value_blob,
+  sqlite3_value_bytes,
+  sqlite3_result_null, sqlite3_result_int, sqlite3_result_int64,
+  sqlite3_result_double, sqlite3_result_text, sqlite3_result_blob,
+  sqlite3_result_error, sqlite3_result_error_code,
+  sqlite3_user_data, sqlite3_context_db_handle,
+  SQLiteArrayAt, SQLiteTransient;
+
+VAR
+  ExitCode : INTEGER;
+  db : ADDRESS;
+  cbRows, rc : INTEGER;
+  cbBad : BOOLEAN;
+  errmsg : ADDRESS;
+  ok : BOOLEAN;
+  bin : ARRAY [0..7] OF CHAR;
+
+PROCEDURE SameText (a, b : ARRAY OF CHAR) : BOOLEAN;
+VAR
+  i : INTEGER;
+BEGIN
+  i := 0;
+  WHILE (a[i] # CHR(0)) AND (a[i] = b[i]) DO
+    i := i + 1
+  END;
+  RETURN (a[i] = CHR(0)) AND (b[i] = CHR(0))
+END SameText;
+
+(* sqlite3_exec row callback. *)
+PROCEDURE RowCb (arg : ADDRESS; argc : INTEGER;
+                 argv, colNames : ADDRESS) : INTEGER;
+VAR
+  value, name : CString;
+  vbuf, nbuf : ARRAY [0..7] OF CHAR;
+BEGIN
+  IF (argc = 1) AND (arg = ADR(cbRows)) THEN
+    value := SQLiteArrayAt(argv, 0);
+    name := SQLiteArrayAt(colNames, 0);
+    IF (value # NIL) AND (name # NIL)
+       AND (Copy(value, vbuf) > 0) AND (Copy(name, nbuf) > 0) THEN
+      IF ((vbuf[0] = '1') OR (vbuf[0] = '2')) AND (nbuf[0] = 'n') THEN
+        cbRows := cbRows + 1
+      ELSE
+        cbBad := TRUE
+      END
+    ELSE
+      cbBad := TRUE
+    END
+  ELSE
+    cbBad := TRUE
+  END;
+  RETURN 0
+END RowCb;
+
+(* Scalar SQL function callbacks. *)
+PROCEDURE AddFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  IF argc = 2 THEN
+    sqlite3_result_int(ctx,
+      sqlite3_value_int(SQLiteArrayAt(argv, 0))
+      + sqlite3_value_int(SQLiteArrayAt(argv, 1)))
+  ELSE
+    sqlite3_result_error(ctx, "m2_add expects 2 arguments", -1)
+  END
+END AddFn;
+
+PROCEDURE MixFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+VAR
+  v : ADDRESS;
+  s : CString;
+  buf : ARRAY [0..7] OF CHAR;
+  n : CARDINAL;
+  good : BOOLEAN;
+BEGIN
+  good := FALSE;
+  IF argc = 4 THEN
+    v := SQLiteArrayAt(argv, 0);
+    good := (sqlite3_value_type(v) = SQLiteInteger)
+            AND (sqlite3_value_int(v) = 7)
+            AND (sqlite3_value_int64(v) = 7);
+
+    v := SQLiteArrayAt(argv, 1);
+    good := good AND (sqlite3_value_type(v) = SQLiteFloat)
+            AND (sqlite3_value_double(v) = 8.5);
+
+    v := SQLiteArrayAt(argv, 2);
+    s := sqlite3_value_text(v);
+    n := Copy(s, buf);
+    good := good AND (sqlite3_value_type(v) = SQLiteText)
+            AND (sqlite3_value_bytes(v) = 2)
+            AND (n = 2) AND (buf[0] = 'h') AND (buf[1] = 'i');
+
+    v := SQLiteArrayAt(argv, 3);
+    good := good AND (sqlite3_value_type(v) = SQLiteNull)
+  END;
+  IF good THEN
+    sqlite3_result_int(ctx, 42)
+  ELSE
+    sqlite3_result_error(ctx, "m2_mix bad arguments", -1)
+  END
+END MixFn;
+
+PROCEDURE EchoFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+VAR
+  v : ADDRESS;
+  s : CString;
+  buf : ARRAY [0..63] OF CHAR;
+  n : CARDINAL;
+BEGIN
+  IF argc = 1 THEN
+    v := SQLiteArrayAt(argv, 0);
+    IF sqlite3_value_type(v) = SQLiteText THEN
+      s := sqlite3_value_text(v);
+      n := Copy(s, buf);
+      sqlite3_result_text(ctx, buf, INTEGER(n), SQLiteTransient())
+    ELSE
+      sqlite3_result_null(ctx)
+    END
+  ELSE
+    sqlite3_result_error(ctx, "m2_echo expects 1 argument", -1)
+  END
+END EchoFn;
+
+PROCEDURE NullFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  sqlite3_result_null(ctx)
+END NullFn;
+
+PROCEDURE Int64Fn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  IF argc = 1 THEN
+    sqlite3_result_int64(ctx,
+      sqlite3_value_int64(SQLiteArrayAt(argv, 0)))
+  ELSE
+    sqlite3_result_error(ctx, "m2_int64 expects 1 argument", -1)
+  END
+END Int64Fn;
+
+PROCEDURE DoubleFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  IF argc = 1 THEN
+    sqlite3_result_double(ctx,
+      sqlite3_value_double(SQLiteArrayAt(argv, 0)))
+  ELSE
+    sqlite3_result_error(ctx, "m2_double expects 1 argument", -1)
+  END
+END DoubleFn;
+
+PROCEDURE BlobFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  sqlite3_result_blob(ctx, ADR(bin[0]), 3, SQLiteTransient())
+END BlobFn;
+
+PROCEDURE BlobLenFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+VAR
+  v, p : ADDRESS;
+BEGIN
+  IF argc = 1 THEN
+    v := SQLiteArrayAt(argv, 0);
+    p := sqlite3_value_blob(v);
+    IF (sqlite3_value_type(v) = SQLiteBlob) AND (p # NIL) THEN
+      sqlite3_result_int(ctx, sqlite3_value_bytes(v))
+    ELSE
+      sqlite3_result_error(ctx, "m2_blob_len expects a BLOB", -1)
+    END
+  ELSE
+    sqlite3_result_error(ctx, "m2_blob_len expects 1 argument", -1)
+  END
+END BlobLenFn;
+
+PROCEDURE DataFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  IF (sqlite3_user_data(ctx) = ADR(db))
+     AND (sqlite3_context_db_handle(ctx) = db) THEN
+    sqlite3_result_int(ctx, 1)
+  ELSE
+    sqlite3_result_int(ctx, 0)
+  END
+END DataFn;
+
+PROCEDURE FailFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
+BEGIN
+  sqlite3_result_error(ctx, "m2_fail", -1);
+  sqlite3_result_error_code(ctx, SQLiteAbort)
+END FailFn;
+
+PROCEDURE QueryInt (sql : ARRAY OF CHAR; want : INTEGER) : BOOLEAN;
+VAR
+  stmt : ADDRESS;
+  rc, got : INTEGER;
+  ok : BOOLEAN;
+BEGIN
+  stmt := NIL; got := -777; ok := FALSE;
+  rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
+  IF (rc = SQLiteOk) AND (stmt # NIL) THEN
+    IF sqlite3_step(stmt) = SQLiteRow THEN
+      got := sqlite3_column_int(stmt, 0);
+      IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
+    END;
+    IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
+  END;
+  RETURN ok AND (got = want)
+END QueryInt;
+
+PROCEDURE QueryInt64 (sql : ARRAY OF CHAR; want : LONGINT) : BOOLEAN;
+VAR
+  stmt : ADDRESS;
+  rc : INTEGER;
+  got : LONGINT;
+  ok : BOOLEAN;
+BEGIN
+  stmt := NIL; got := -777; ok := FALSE;
+  rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
+  IF (rc = SQLiteOk) AND (stmt # NIL) THEN
+    IF sqlite3_step(stmt) = SQLiteRow THEN
+      got := sqlite3_column_int64(stmt, 0);
+      IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
+    END;
+    IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
+  END;
+  RETURN ok AND (got = want)
+END QueryInt64;
+
+PROCEDURE QueryDouble (sql : ARRAY OF CHAR; want : REAL) : BOOLEAN;
+VAR
+  stmt : ADDRESS;
+  rc : INTEGER;
+  got : REAL;
+  ok : BOOLEAN;
+BEGIN
+  stmt := NIL; got := -777.0; ok := FALSE;
+  rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
+  IF (rc = SQLiteOk) AND (stmt # NIL) THEN
+    IF sqlite3_step(stmt) = SQLiteRow THEN
+      got := sqlite3_column_double(stmt, 0);
+      IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
+    END;
+    IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
+  END;
+  RETURN ok AND (got = want)
+END QueryDouble;
+
+PROCEDURE QueryText (sql : ARRAY OF CHAR; want : ARRAY OF CHAR) : BOOLEAN;
+VAR
+  stmt : ADDRESS;
+  rc : INTEGER;
+  s : CString;
+  buf : ARRAY [0..63] OF CHAR;
+  ok : BOOLEAN;
+BEGIN
+  stmt := NIL; ok := FALSE;
+  rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
+  IF (rc = SQLiteOk) AND (stmt # NIL) THEN
+    IF sqlite3_step(stmt) = SQLiteRow THEN
+      s := sqlite3_column_text(stmt, 0);
+      IF (s # NIL) AND (Copy(s, buf) > 0) THEN
+        ok := SameText(buf, want)
+      END;
+      IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
+    END;
+    IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
+  END;
+  RETURN ok
+END QueryText;
+
+PROCEDURE QueryFails (sql : ARRAY OF CHAR) : BOOLEAN;
+VAR
+  stmt : ADDRESS;
+  rc : INTEGER;
+  s : CString;
+  buf : ARRAY [0..63] OF CHAR;
+  ok : BOOLEAN;
+BEGIN
+  stmt := NIL; ok := FALSE;
+  rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
+  IF (rc = SQLiteOk) AND (stmt # NIL) THEN
+    IF sqlite3_step(stmt) = SQLiteAbort THEN
+      s := sqlite3_errmsg(db);
+      IF (s # NIL) AND (Copy(s, buf) > 0)
+         AND SameText(buf, "m2_fail") THEN
+        ok := TRUE
+      END
+    END;
+    rc := sqlite3_finalize(stmt)
+  END;
+  RETURN ok
+END QueryFails;
+
+PROCEDURE Register (name : ARRAY OF CHAR;
+                    nArgs : INTEGER;
+                    userData, fn : ADDRESS) : BOOLEAN;
+BEGIN
+  RETURN sqlite3_create_function_v2(db, name, nArgs,
+    SQLiteUtf8 + SQLiteDeterministic, userData, fn, NIL, NIL, NIL)
+    = SQLiteOk
+END Register;
+
+BEGIN
+  ExitCode := 1;
+  db := NIL; cbRows := 0; cbBad := FALSE;
+  bin[0] := CHR(0); bin[1] := CHR(1); bin[2] := CHR(2);
+  bin[3] := CHR(0); bin[4] := CHR(255);
+
+  IF (sqlite3_open_v2(":memory:", db,
+        SQLiteOpenReadWrite + SQLiteOpenCreate + SQLiteOpenMemory,
+        NIL) = SQLiteOk) AND (db # NIL) THEN
+    IF Register("m2_add", 2, NIL, ADR(AddFn))
+       AND Register("m2_mix", 4, NIL, ADR(MixFn))
+       AND Register("m2_echo", 1, NIL, ADR(EchoFn))
+       AND Register("m2_null", 0, NIL, ADR(NullFn))
+       AND Register("m2_int64", 1, NIL, ADR(Int64Fn))
+       AND Register("m2_double", 1, NIL, ADR(DoubleFn))
+       AND Register("m2_blob", 0, NIL, ADR(BlobFn))
+       AND Register("m2_blob_len", 1, NIL, ADR(BlobLenFn))
+       AND Register("m2_hasdata", 0, ADR(db), ADR(DataFn))
+       AND Register("m2_fail", 0, NIL, ADR(FailFn)) THEN
+      ok := TRUE
+    ELSE
+      ok := FALSE
+    END
+  END;
+
+  IF ok THEN ok := QueryInt("SELECT m2_add(20, 22);", 42) END;
+  IF ok THEN
+    ok := QueryInt("SELECT m2_mix(7, 8.5, 'hi', NULL);", 42)
+  END;
+  IF ok THEN ok := QueryText("SELECT m2_echo('hello');", "hello") END;
+  IF ok THEN ok := QueryInt("SELECT m2_echo(NULL) IS NULL;", 1) END;
+  IF ok THEN ok := QueryInt("SELECT m2_null() IS NULL;", 1) END;
+  IF ok THEN ok := QueryInt64("SELECT m2_int64(42);", 42) END;
+  IF ok THEN ok := QueryDouble("SELECT m2_double(3.5);", 3.5) END;
+  IF ok THEN ok := QueryText("SELECT hex(m2_blob());", "000102") END;
+  IF ok THEN
+    ok := QueryInt("SELECT m2_blob_len(zeroblob(3));", 3)
+  END;
+  IF ok THEN ok := QueryInt("SELECT m2_hasdata();", 1) END;
+  IF ok THEN ok := QueryFails("SELECT m2_fail();") END;
+
+  IF ok THEN
+    cbRows := 0; cbBad := FALSE; errmsg := NIL;
+    rc := sqlite3_exec(db, "SELECT 1 AS n UNION ALL SELECT 2;",
+                       ADR(RowCb), ADR(cbRows), errmsg);
+    ok := (rc = SQLiteOk) AND (NOT cbBad) AND (cbRows = 2);
+    IF errmsg # NIL THEN
+      sqlite3_free(errmsg);
+      errmsg := NIL
+    END
+  END;
+
+  IF db # NIL THEN
+    IF sqlite3_close_v2(db) # SQLiteOk THEN ok := FALSE END
+  END;
+  IF ok THEN ExitCode := 42 END
+END SQLiteCallback.

+ 8 - 0
runtime/syslib/shim.c

@@ -447,6 +447,14 @@ void *m2_sqlite_transient(void)
     return (void *)-1;
 }
 
+/* Index a C array of pointers (char ** or sqlite3_value **). */
+void *m2_sqlite_array_at(void **array, int idx)
+{
+    if (array == NULL || idx < 0)
+        return NULL;
+    return array[idx];
+}
+
 /* C callback test: call a V3 top-level procedure with C arguments. */
 int m2_c_call_add(void *fn, int a, int b)
 {