Przeglądaj źródła

v0.2.0: custom SQL functions (create_function, value/result family, aggregates)

Eric Streit 2 tygodni temu
rodzic
commit
0207b680ea
9 zmienionych plików z 615 dodań i 20 usunięć
  1. 1 1
      Makefile
  2. 9 4
      README.md
  3. 36 5
      docs/summary-v0.2.0.md
  4. 4 1
      lib/SQLiteUtils.def
  5. 13 2
      lib/SQLiteUtils.mod
  6. 66 5
      showcases/showcase_all.mod
  7. 118 1
      src/SQLite.def
  8. 1 1
      tests/run_tests.sh
  9. 367 0
      tests/test_func.mod

+ 1 - 1
Makefile

@@ -23,7 +23,7 @@ OBJS    := $(OBJDIR)/SQLiteUtils.o
 
 INCLUDES := -I$(SRC_DIR) -I$(LIB_DIR)
 
-TESTS    := test_version test_open test_exec test_prepare
+TESTS    := test_version test_open test_exec test_prepare test_func
 EXAMPLES := version hello_db
 SHOWCASES := showcase_all
 

+ 9 - 4
README.md

@@ -15,10 +15,10 @@ Starter set, verified with gm2 16.0.1 + SQLite 3.46.1 (system
 
 | Module | C header | Contents |
 |---|---|---|
-| `SQLite` | `<sqlite3.h>` (`sqlite-master/src/sqlite.h.in`) | version, open/close, exec, errcode/errmsg, prepare/step/finalize/reset, bind_*, column_*, changes/rowid, busy_timeout, limits |
-| `SQLiteUtils` (`lib/`) | — | `CStrToM2()` + `ErrMsg()`/`ErrStr()`/`LibVersionStr()`, `StaticDestr()`/`TransientDestr()`, `BindTextCopy()`/`BindBlobCopy()`, `ExecSimple()`/`ExecWithErr()` |
+| `SQLite` | `<sqlite3.h>` (`sqlite-master/src/sqlite.h.in`) | version, open/close, exec, errcode/errmsg, prepare/step/finalize/reset, bind_*, column_*, changes/rowid, busy_timeout, limits, custom functions (create_function, value_*, result_*, aggregate/userdata/auxdata context) |
+| `SQLiteUtils` (`lib/`) | — | `CStrToM2()` + `ErrMsg()`/`ErrStr()`/`LibVersionStr()`, `StaticDestr()`/`TransientDestr()`, `BindTextCopy()`/`BindBlobCopy()`, `ValueText()`/`ResultTextCopy()`, `ExecSimple()`/`ExecWithErr()` |
 
-Custom SQL functions (`create_function`), blobs (`blob_open`),
+Window functions (`create_window_function`), blobs (`blob_open`),
 backups and sessions come next.
 
 ## Layout
@@ -90,6 +90,11 @@ Notes:
   `ADDRESS`: pass `ADR(msg)` or `NIL`.
 - `bind_text`/`bind_blob` destructors: pass `VAL(ADDRESS, -1)` for
   `SQLITE_TRANSIENT` (copy) or use `BindTextCopy()`/`BindBlobCopy()`.
+- Custom functions: declare module-level procedures of the `XFunc` /
+  `XStep` / `XFinal` types and pass them to `sqlite3_create_function`
+  (C calls them directly — verified); `NIL` for unused callbacks.
+  Index the `argv` vector with a `VAL` overlay onto an `ADDRESS`
+  array (see `tests/test_func.mod` `ArgAt`).
 - `INTEGER <-> int`, `LONGINT <-> sqlite3_int64`, `REAL <-> double`
   (see gm2 "Elementary data types" node and `libc.atof`).
   Pass `INTEGER` constants through a variable before handing them
@@ -103,6 +108,6 @@ prepare, binds, columns, close) and prints each result.
 
 ## Roadmap
 
-1. `sqlite3_create_function` + value/result family (custom functions).
+1. Window functions (`create_window_function`) + collations.
 2. Incremental BLOB I/O (`blob_open/read/write`) + backup API.
 3. Extended result codes as named constants + `sqlite3_get_table` wrapper.

+ 36 - 5
docs/summary-v0.1.0.md → docs/summary-v0.2.0.md

@@ -1,8 +1,8 @@
-# m2SQLITE summary — v0.1.0 (2026-09-24)
+# m2SQLITE summary — v0.2.0 (2026-09-24)
 
 SQLite bindings for GNU Modula-2 (`gm2` 16.0.1, SQLite 3.46.1 system
 `libsqlite3.so.0`, Linux; API reference `sqlite-master/` 3.54.0).
-All builds verified with `make`; tests 4/4 green, showcase exits 0.
+All builds verified with `make`; tests 5/5 green, showcase exits 0.
 
 ## v0.1.0 — core binding + showcase
 
@@ -21,14 +21,40 @@ All builds verified with `make`; tests 4/4 green, showcase exits 0.
   and error capture), prepare/bind/column round trip + `run_tests.sh`
 - `examples/` — `version`, `hello_db` (bind-insert, select-print)
 - `showcases/showcase_all` — calls every `SQLite` procedure and every
-  `SQLiteUtils` helper in 7 sections (info, settings, errors, prepare,
-  binds, columns, close); verifies values, prints each result
+  `SQLiteUtils` helper in 7 sections; verifies values, prints results
 - `Makefile` — gm2 build (`-c` helper to `.o`, then link) for tests,
   examples and showcases; `pkg-config` with runtime-lib fallback;
   optional `local-sqlite` amalgamation target
 - `.gitignore` — ignores `sqlite-master/`, `build/`, artefacts, `*.db`
 - `README.md` — status table, layout, build/test, usage, FFI notes
 
+## v0.2.0 — custom SQL functions
+
+- `src/SQLite.def` — function API (+30 procedures): `XFunc`/`XStep`/
+  `XFinal`/`XDestroy` callback types (`ContextHandle`, `ValueHandle`),
+  `create_function`/`create_function_v2`, all `value_*` readers
+  (blob/double/int/int64/text/bytes/type/numeric-type), all `result_*`
+  writers (blob/blob64/double/error(+code/toobig/nomem)/int/int64/null/
+  text/text64/value/zeroblob/zeroblob64), context helpers
+  (`aggregate_context`, `user_data`, `context_db_handle`,
+  `get/set_auxdata`); UTF-encoding and function-flag constants
+  (UTF8/UTF16 variants, DETERMINISTIC/DIRECTONLY/SUBTYPE/INNOCUOUS/
+  RESULT_SUBTYPE/SELFORDER1). 16-bit and window-function APIs
+  deliberately omitted (noted in README roadmap).
+- `lib/SQLiteUtils` — `ValueText` (value handle into CHAR array),
+  `ResultTextCopy` (TRANSIENT text result)
+- `tests/test_func` — 17 registered functions: scalar double/text/
+  int64/blob-echo/type-probe/null-passthrough, sized results
+  (zeroblob/64, blob64, text64), error paths (exact codes 1/18/7
+  verified), `msum` aggregate with `aggregate_context` state,
+  `user_data` call counting and `context_db_handle` check, auxdata
+  set/get round trip, `create_function_v2` + DETERMINISTIC flag
+- `showcases/showcase_all` — new section [8]: `m2tax` scalar and
+  `m2total` aggregate over a table (close moves to [9])
+- Key result: module-level Modula-2 procedures ARE C-compatible
+  function pointers (proven by spike against real `libsqlite3`,
+  then by the suite); `NIL` accepted for unused callbacks
+
 ## GM2 FFI rules learned (encoded in code)
 
 1. `DEFINITION MODULE FOR "C"` needs `EXPORT UNQUALIFIED`, otherwise
@@ -47,8 +73,13 @@ All builds verified with `make`; tests 4/4 green, showcase exits 0.
    route them via variables first.
 7. No dev package needed: link `/usr/lib/x86_64-linux-gnu/libsqlite3.so.0`
    directly when `pkg-config sqlite3` is absent.
+8. Callback types (`PROCEDURE (ADDRESS, ...)`) cross into C as plain
+   function pointers; `NIL` fills unused slots. Index C pointer
+   arrays with a `VAL` overlay onto `POINTER TO ARRAY OF ADDRESS`.
+9. This SQLite build rejects the `AS t(v)` column-alias form in
+   `FROM (VALUES ...)`; use bare `column1` names in tests.
 
 ## Next
 
-Custom SQL functions (`create_function` + value/result family),
+Window functions (`create_window_function`) + collations,
 incremental BLOB I/O + backup API, extended result-code constants.

+ 4 - 1
lib/SQLiteUtils.def

@@ -10,12 +10,13 @@ DEFINITION MODULE SQLiteUtils ;
 *)
 
 FROM SYSTEM IMPORT ADDRESS;
-FROM SQLite IMPORT DbHandle, StmtHandle;
+FROM SQLite IMPORT DbHandle, StmtHandle, ContextHandle, ValueHandle;
 
 EXPORT UNQUALIFIED
    CStrToM2, ErrMsg, ErrStr, LibVersionStr,
    StaticDestr, TransientDestr,
    BindTextCopy, BindBlobCopy,
+   ValueText, ResultTextCopy,
    ExecSimple, ExecWithErr;
 
 PROCEDURE CStrToM2 (src: ADDRESS; VAR dst: ARRAY OF CHAR);
@@ -28,6 +29,8 @@ PROCEDURE BindTextCopy (stmt: StmtHandle; idx: INTEGER;
                         v: ARRAY OF CHAR) : INTEGER;
 PROCEDURE BindBlobCopy (stmt: StmtHandle; idx: INTEGER;
                         data: ADDRESS; n: INTEGER) : INTEGER;
+PROCEDURE ValueText (v: ValueHandle; VAR buf: ARRAY OF CHAR);
+PROCEDURE ResultTextCopy (ctx: ContextHandle; str: ARRAY OF CHAR);
 PROCEDURE ExecSimple (db: DbHandle; sql: ARRAY OF CHAR) : INTEGER;
 PROCEDURE ExecWithErr (db: DbHandle; sql: ARRAY OF CHAR;
                        VAR buf: ARRAY OF CHAR) : INTEGER;

+ 13 - 2
lib/SQLiteUtils.mod

@@ -1,10 +1,11 @@
 IMPLEMENTATION MODULE SQLiteUtils ;
 
 FROM SYSTEM IMPORT ADDRESS, ADR;
-FROM SQLite IMPORT DbHandle, StmtHandle,
+FROM SQLite IMPORT DbHandle, StmtHandle, ContextHandle, ValueHandle,
    sqlite3_libversion, sqlite3_errmsg, sqlite3_errstr,
    sqlite3_exec, sqlite3_free,
-   sqlite3_bind_text, sqlite3_bind_blob;
+   sqlite3_bind_text, sqlite3_bind_blob,
+   sqlite3_value_text, sqlite3_result_text;
 FROM libc IMPORT strlen, strncpy;
 
 PROCEDURE CStrToM2 (src: ADDRESS; VAR dst: ARRAY OF CHAR);
@@ -55,6 +56,16 @@ BEGIN
    RETURN sqlite3_bind_blob(stmt, idx, data, n, TransientDestr())
 END BindBlobCopy;
 
+PROCEDURE ValueText (v: ValueHandle; VAR buf: ARRAY OF CHAR);
+BEGIN
+   CStrToM2(sqlite3_value_text(v), buf)
+END ValueText;
+
+PROCEDURE ResultTextCopy (ctx: ContextHandle; str: ARRAY OF CHAR);
+BEGIN
+   sqlite3_result_text(ctx, str, -1, TransientDestr())
+END ResultTextCopy;
+
 PROCEDURE ExecSimple (db: DbHandle; sql: ARRAY OF CHAR) : INTEGER;
 BEGIN
    RETURN sqlite3_exec(db, sql, NIL, NIL, NIL)

+ 66 - 5
showcases/showcase_all.mod

@@ -10,15 +10,18 @@ MODULE showcase_all ;
    4. prepare_v2 tail capture, prepare_v3 flags, sql text, parameter ids
    5. all bind kinds, step, changes counters, rowid
    6. all column kinds, metadata, busy/reset/rebind, transactions
-   7. expanded sql, zeroblob, static destructor, close_v2, close
+   7. expanded sql, zeroblob, static destructor, close_v2
+   8. custom functions: scalar tax plus aggregate total
+   9. close
 *)
 
 FROM SYSTEM IMPORT ADDRESS, ADR;
-FROM SQLite IMPORT DbHandle, StmtHandle,
+FROM SQLite IMPORT DbHandle, StmtHandle, ContextHandle, ValueHandle,
    SQLiteOk, SQLiteRow, SQLiteDone,
    SQLiteInteger, SQLiteFloat, SQLiteText, SQLiteBlob, SQLiteNull,
    SQLiteOpenReadWrite, SQLiteOpenCreate,
    SQLitePreparePersistent, SQLiteLimitVariableNumber,
+   SQLiteUtf8, SQLiteDeterministic,
    sqlite3_libversion, sqlite3_libversion_number, sqlite3_sourceid,
    sqlite3_threadsafe,
    sqlite3_open, sqlite3_open_v2, sqlite3_close, sqlite3_close_v2,
@@ -40,12 +43,20 @@ FROM SQLite IMPORT DbHandle, StmtHandle,
    sqlite3_bind_parameter_index,
    sqlite3_column_blob, sqlite3_column_double, sqlite3_column_int,
    sqlite3_column_int64, sqlite3_column_text, sqlite3_column_bytes,
-   sqlite3_column_type, sqlite3_column_name, sqlite3_column_decltype;
+   sqlite3_column_type, sqlite3_column_name, sqlite3_column_decltype,
+   sqlite3_create_function,
+   sqlite3_value_int64, sqlite3_value_double,
+   sqlite3_result_double, sqlite3_result_int64,
+   sqlite3_aggregate_context;
 FROM SQLiteUtils IMPORT CStrToM2, ErrMsg, ErrStr, LibVersionStr,
    StaticDestr, TransientDestr,
    BindTextCopy, BindBlobCopy, ExecSimple, ExecWithErr;
 FROM libc IMPORT printf, strncpy;
 
+TYPE
+   ArgVec = POINTER TO ARRAY [0..255] OF ADDRESS;
+   TotalPtr = POINTER TO LONGINT;
+
 VAR
    db, db2: DbHandle;
    stmt: StmtHandle;
@@ -78,6 +89,33 @@ BEGIN
    printf("--- [%d] %s ---\n", n, title)
 END section;
 
+PROCEDURE ArgAt (argv: ADDRESS; i: INTEGER) : ValueHandle;
+VAR vec: ArgVec;
+BEGIN
+   vec := VAL(ArgVec, argv);
+   RETURN vec^[i]
+END ArgAt;
+
+PROCEDURE tax (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_double(ctx,
+      sqlite3_value_double(ArgAt(argv, 0)) * 1.2)
+END tax;
+
+PROCEDURE totalStep (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR s: TotalPtr;
+BEGIN
+   s := VAL(TotalPtr, sqlite3_aggregate_context(ctx, 8));
+   s^ := s^ + sqlite3_value_int64(ArgAt(argv, 0))
+END totalStep;
+
+PROCEDURE totalFinal (ctx: ContextHandle);
+VAR s: TotalPtr;
+BEGIN
+   s := VAL(TotalPtr, sqlite3_aggregate_context(ctx, 0));
+   sqlite3_result_int64(ctx, s^)
+END totalFinal;
+
 BEGIN
    staticBlob[0] := 'W'; staticBlob[1] := 'X';
    staticBlob[2] := 'Y'; staticBlob[3] := 'Z';
@@ -279,8 +317,31 @@ BEGIN
    IF sqlite3_get_autocommit(db) = 0 THEN HALT(1) END;
    printf("total changes %d\n", sqlite3_total_changes(db));
 
-   (* 7. close paths *)
-   section(7, "close");
+   (* 8. custom functions *)
+   section(8, "custom functions");
+   check(sqlite3_create_function(db, "m2tax", 1,
+                                 SQLiteUtf8 + SQLiteDeterministic,
+                                 NIL, tax, NIL, NIL), "reg tax");
+   check(sqlite3_create_function(db, "m2total", 1, SQLiteUtf8, NIL,
+                                 NIL, totalStep, totalFinal),
+         "reg total");
+   check(ExecSimple(db, "CREATE TABLE fx(price REAL);"), "fx create");
+   check(ExecSimple(db, "INSERT INTO fx VALUES(10.0),(20.0),(30.0);"),
+         "fx fill");
+   check(sqlite3_prepare_v2(db, "SELECT m2tax(100.0), m2total(price)"
+                                + " FROM fx;",
+                            -1, stmt, NIL), "prep fx");
+   rc := sqlite3_step(stmt);
+   IF rc # SQLiteRow THEN fail("fx step") END;
+   d := sqlite3_column_double(stmt, 0);
+   li := sqlite3_column_int64(stmt, 1);
+   printf("taxed %f totalled %ld\n", d, li);
+   IF (d < 119.9) OR (d > 120.1) THEN fail("fx tax") END;
+   IF li # 60 THEN fail("fx total") END;
+   check(sqlite3_finalize(stmt), "fin fx");
+
+   (* 9. close paths *)
+   section(9, "close");
    check(sqlite3_close_v2(db2), "close_v2");
    check(sqlite3_close(db), "close");
    printf("PASS showcase_all\n")

+ 118 - 1
src/SQLite.def

@@ -86,12 +86,45 @@ EXPORT UNQUALIFIED
    sqlite3_bind_parameter_index,
    sqlite3_column_blob, sqlite3_column_double, sqlite3_column_int,
    sqlite3_column_int64, sqlite3_column_text, sqlite3_column_bytes,
-   sqlite3_column_type, sqlite3_column_name, sqlite3_column_decltype;
+   sqlite3_column_type, sqlite3_column_name, sqlite3_column_decltype,
+
+   ContextHandle, ValueHandle, XFunc, XStep, XFinal, XDestroy,
+
+   SQLiteUtf8, SQLiteUtf16LE, SQLiteUtf16BE, SQLiteUtf16, SQLiteUtfAny,
+   SQLiteDeterministic, SQLiteDirectOnly, SQLiteSubtype,
+   SQLiteInnocuous, SQLiteResultSubtype, SQLiteSelfOrder1,
+
+   sqlite3_create_function, sqlite3_create_function_v2,
+   sqlite3_value_blob, sqlite3_value_double, sqlite3_value_int,
+   sqlite3_value_int64, sqlite3_value_text, sqlite3_value_bytes,
+   sqlite3_value_type, sqlite3_value_numeric_type,
+   sqlite3_result_blob, sqlite3_result_blob64, sqlite3_result_double,
+   sqlite3_result_error, sqlite3_result_error_code,
+   sqlite3_result_error_toobig, sqlite3_result_error_nomem,
+   sqlite3_result_int, sqlite3_result_int64, sqlite3_result_null,
+   sqlite3_result_text, sqlite3_result_text64, sqlite3_result_value,
+   sqlite3_result_zeroblob, sqlite3_result_zeroblob64,
+   sqlite3_aggregate_context, sqlite3_user_data,
+   sqlite3_context_db_handle, sqlite3_get_auxdata, sqlite3_set_auxdata;
 
 
 TYPE
    DbHandle   = ADDRESS;   (* sqlite3 handle *)
    StmtHandle = ADDRESS;   (* sqlite3_stmt handle *)
+   ContextHandle = ADDRESS;   (* sqlite3_context handle *)
+   ValueHandle   = ADDRESS;   (* sqlite3_value handle *)
+
+   (* Callback types for application-defined SQL functions.
+      Declare module-level procedures of these types and pass them
+      to create_function; C calls them directly. Pass NIL for any
+      callback the function does not need. The argv vector is a C
+      array of value handles; index it with a VAL overlay, e.g.
+      vec := VAL(VecPtr, argv) with VecPtr a pointer to an array
+      of ADDRESS. See tests/test_func.mod for the idiom. *)
+   XFunc    = PROCEDURE (ContextHandle, INTEGER, ADDRESS);
+   XStep    = PROCEDURE (ContextHandle, INTEGER, ADDRESS);
+   XFinal   = PROCEDURE (ContextHandle);
+   XDestroy = PROCEDURE (ADDRESS);
 
 CONST
    (* --- primary result codes (sqlite.h.in) --- *)
@@ -177,6 +210,21 @@ CONST
    SQLiteLimitTriggerDepth      = 10;
    SQLiteLimitWorkerThreads     = 11;
 
+   (* --- text encodings for create_function --- *)
+   SQLiteUtf8     = 1;
+   SQLiteUtf16LE  = 2;
+   SQLiteUtf16BE  = 3;
+   SQLiteUtf16    = 4;
+   SQLiteUtfAny   = 5;
+
+   (* --- create_function flags --- *)
+   SQLiteDeterministic = 2048;
+   SQLiteDirectOnly    = 524288;
+   SQLiteSubtype       = 1048576;
+   SQLiteInnocuous     = 2097152;
+   SQLiteResultSubtype = 16777216;
+   SQLiteSelfOrder1    = 33554432;
+
 
 (* const char *sqlite3_libversion(void) *)
 PROCEDURE sqlite3_libversion () : ADDRESS;
@@ -368,4 +416,73 @@ PROCEDURE sqlite3_column_name (stmt: StmtHandle; col: INTEGER) : ADDRESS;
 PROCEDURE sqlite3_column_decltype (stmt: StmtHandle;
                                    col: INTEGER) : ADDRESS;
 
+(* Register a scalar or aggregate SQL function implemented in
+   Modula-2. nArg is the arity, or -1 for variadic. textRep is one
+   of the SQLiteUtf encodings, usually ORed with flag constants such
+   as SQLiteDeterministic. app is passed through to user_data.
+   Scalar: pass xFunc, NIL for the rest. Aggregate: pass NIL xFunc
+   with xStep and xFinal. *)
+PROCEDURE sqlite3_create_function (db: DbHandle; name: ARRAY OF CHAR;
+                                   nArg, textRep: INTEGER; app: ADDRESS;
+                                   xFunc: XFunc; xStep: XStep;
+                                   xFinal: XFinal) : INTEGER;
+
+(* As above, with a destroy callback for app invoked at teardown.
+   Pass NIL when app needs no cleanup. *)
+PROCEDURE sqlite3_create_function_v2 (db: DbHandle; name: ARRAY OF CHAR;
+                                      nArg, textRep: INTEGER; app: ADDRESS;
+                                      xFunc: XFunc; xStep: XStep;
+                                      xFinal: XFinal;
+                                      xDestroy: XDestroy) : INTEGER;
+
+(* Argument readers, for use inside xFunc and xStep. *)
+PROCEDURE sqlite3_value_blob (v: ValueHandle) : ADDRESS;
+PROCEDURE sqlite3_value_double (v: ValueHandle) : REAL;
+PROCEDURE sqlite3_value_int (v: ValueHandle) : INTEGER;
+PROCEDURE sqlite3_value_int64 (v: ValueHandle) : LONGINT;
+PROCEDURE sqlite3_value_text (v: ValueHandle) : ADDRESS;
+PROCEDURE sqlite3_value_bytes (v: ValueHandle) : INTEGER;
+PROCEDURE sqlite3_value_type (v: ValueHandle) : INTEGER;
+PROCEDURE sqlite3_value_numeric_type (v: ValueHandle) : INTEGER;
+
+(* Result writers, for use inside xFunc, xStep and xFinal.
+   Text, blob and error writers take -1 for NUL-terminated input.
+   The destructor takes the STATIC or TRANSIENT sentinel, see the
+   header note and SQLiteUtils.TransientDestr. *)
+PROCEDURE sqlite3_result_blob (ctx: ContextHandle; data: ADDRESS;
+                               n: INTEGER; destr: ADDRESS);
+PROCEDURE sqlite3_result_blob64 (ctx: ContextHandle; data: ADDRESS;
+                                 n: LONGCARD; destr: ADDRESS);
+PROCEDURE sqlite3_result_double (ctx: ContextHandle; v: REAL);
+PROCEDURE sqlite3_result_error (ctx: ContextHandle;
+                                msg: ARRAY OF CHAR; n: INTEGER);
+PROCEDURE sqlite3_result_error_code (ctx: ContextHandle; code: INTEGER);
+PROCEDURE sqlite3_result_error_toobig (ctx: ContextHandle);
+PROCEDURE sqlite3_result_error_nomem (ctx: ContextHandle);
+PROCEDURE sqlite3_result_int (ctx: ContextHandle; v: INTEGER);
+PROCEDURE sqlite3_result_int64 (ctx: ContextHandle; v: LONGINT);
+PROCEDURE sqlite3_result_null (ctx: ContextHandle);
+PROCEDURE sqlite3_result_text (ctx: ContextHandle;
+                               v: ARRAY OF CHAR; n: INTEGER;
+                               destr: ADDRESS);
+PROCEDURE sqlite3_result_text64 (ctx: ContextHandle;
+                                 v: ARRAY OF CHAR; n: LONGCARD;
+                                 destr: ADDRESS; enc: INTEGER);
+PROCEDURE sqlite3_result_value (ctx: ContextHandle; v: ValueHandle);
+PROCEDURE sqlite3_result_zeroblob (ctx: ContextHandle; n: INTEGER);
+PROCEDURE sqlite3_result_zeroblob64 (ctx: ContextHandle;
+                                     n: LONGCARD) : INTEGER;
+
+(* Per-call context helpers. aggregate_context allocates nBytes of
+   zeroed state on first use per aggregate instance; call with 0 to
+   fetch it in xFinal. user_data returns the app pointer given at
+   registration. Auxdata caches a pointer per argument across rows. *)
+PROCEDURE sqlite3_aggregate_context (ctx: ContextHandle;
+                                     nBytes: INTEGER) : ADDRESS;
+PROCEDURE sqlite3_user_data (ctx: ContextHandle) : ADDRESS;
+PROCEDURE sqlite3_context_db_handle (ctx: ContextHandle) : DbHandle;
+PROCEDURE sqlite3_get_auxdata (ctx: ContextHandle; idx: INTEGER) : ADDRESS;
+PROCEDURE sqlite3_set_auxdata (ctx: ContextHandle; idx: INTEGER;
+                               p: ADDRESS; destr: XDestroy);
+
 END SQLite.

+ 1 - 1
tests/run_tests.sh

@@ -20,7 +20,7 @@ fi
 # shellcheck disable=SC2086
 $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS -c "$ROOT/lib/SQLiteUtils.mod" -o "$OBJ/SQLiteUtils.o"
 pass=0; fail=0
-for t in test_version test_open test_exec test_prepare; do
+for t in test_version test_open test_exec test_prepare test_func; do
   echo "== $t =="
   # shellcheck disable=SC2086
   $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS "$ROOT/tests/$t.mod" \

+ 367 - 0
tests/test_func.mod

@@ -0,0 +1,367 @@
+MODULE test_func ;
+
+(*
+   m2SQLITE test: application-defined SQL functions. Covers scalar
+   registration, every value reader and result writer used here,
+   error paths, an aggregate with shared state and userdata, and
+   the auxdata round trip.
+*)
+
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM SQLite IMPORT DbHandle, StmtHandle, ContextHandle, ValueHandle,
+   SQLiteOk, SQLiteRow, SQLiteDone,
+   SQLiteInteger, SQLiteText, SQLiteNull,
+   SQLiteTooBig, SQLiteUtf8, SQLiteDeterministic,
+   sqlite3_open, sqlite3_close,
+   sqlite3_prepare_v2, sqlite3_step, sqlite3_finalize,
+   sqlite3_create_function, sqlite3_create_function_v2,
+   sqlite3_value_blob, sqlite3_value_double, sqlite3_value_int,
+   sqlite3_value_int64, sqlite3_value_text, sqlite3_value_bytes,
+   sqlite3_value_type, sqlite3_value_numeric_type,
+   sqlite3_result_blob, sqlite3_result_blob64, sqlite3_result_double,
+   sqlite3_result_error, sqlite3_result_error_code,
+   sqlite3_result_error_toobig, sqlite3_result_error_nomem,
+   sqlite3_result_int, sqlite3_result_int64, sqlite3_result_null,
+   sqlite3_result_text, sqlite3_result_text64, sqlite3_result_value,
+   sqlite3_result_zeroblob, sqlite3_result_zeroblob64,
+   sqlite3_aggregate_context, sqlite3_user_data,
+   sqlite3_context_db_handle, sqlite3_get_auxdata, sqlite3_set_auxdata,
+   sqlite3_column_int, sqlite3_column_int64, sqlite3_column_double,
+   sqlite3_column_text,
+   sqlite3_errmsg;
+FROM SQLiteUtils IMPORT CStrToM2, ErrMsg, TransientDestr;
+FROM libc IMPORT printf;
+
+TYPE
+   AddrVec = POINTER TO ARRAY [0..255] OF ADDRESS;
+   ByteVec = POINTER TO ARRAY [0..1023] OF CHAR;
+   SumPtr = POINTER TO LONGINT;
+   CntPtr = POINTER TO INTEGER;
+
+VAR
+   db: DbHandle; stmt: StmtHandle;
+   stepCalls: INTEGER; dbBad: BOOLEAN; auxSlot: ADDRESS;
+
+PROCEDURE fail (what: ARRAY OF CHAR);
+VAR e: ARRAY [0..255] OF CHAR;
+BEGIN
+   ErrMsg(db, e);
+   printf("FAIL %s: %s\n", what, e);
+   HALT(1)
+END fail;
+
+PROCEDURE check (rc: INTEGER; what: ARRAY OF CHAR);
+BEGIN
+   IF rc # SQLiteOk THEN fail(what) END
+END check;
+
+PROCEDURE ArgAt (argv: ADDRESS; i: INTEGER) : ValueHandle;
+VAR vec: AddrVec;
+BEGIN
+   vec := VAL(AddrVec, argv);
+   RETURN vec^[i]
+END ArgAt;
+
+PROCEDURE oneRow (sql: ARRAY OF CHAR; what: ARRAY OF CHAR);
+VAR rc: INTEGER;
+BEGIN
+   check(sqlite3_prepare_v2(db, sql, -1, stmt, NIL), what);
+   rc := sqlite3_step(stmt);
+   IF rc # SQLiteRow THEN fail(what) END
+END oneRow;
+
+PROCEDURE endRow (what: ARRAY OF CHAR);
+VAR rc: INTEGER;
+BEGIN
+   rc := sqlite3_step(stmt);
+   IF rc # SQLiteDone THEN fail(what) END;
+   check(sqlite3_finalize(stmt), what)
+END endRow;
+
+PROCEDURE errCase (sql: ARRAY OF CHAR; tag: INTEGER);
+VAR rc: INTEGER;
+BEGIN
+   check(sqlite3_prepare_v2(db, sql, -1, stmt, NIL), "err2 prep");
+   rc := sqlite3_step(stmt);
+   printf("errcase %d rc %d\n", tag, rc);
+   IF rc = SQLiteOk THEN fail("err2 ok") END;
+   rc := sqlite3_finalize(stmt)
+END errCase;
+
+(* dbl(x) = 2*x, errors on missing argument *)
+PROCEDURE dbl (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   IF argc < 1 THEN
+      sqlite3_result_error(ctx, "need an argument", -1);
+      RETURN
+   END;
+   sqlite3_result_double(ctx, sqlite3_value_double(ArgAt(argv, 0)) * 2.0)
+END dbl;
+
+(* shout(t) uppercases ASCII text *)
+PROCEDURE shout (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR v: ValueHandle; p: ByteVec; n, i: INTEGER; c: CHAR;
+    out: ARRAY [0..127] OF CHAR;
+BEGIN
+   IF argc < 1 THEN
+      sqlite3_result_error(ctx, "need an argument", -1);
+      RETURN
+   END;
+   v := ArgAt(argv, 0);
+   n := sqlite3_value_bytes(v);
+   IF n > 127 THEN n := 127 END;
+   p := VAL(ByteVec, sqlite3_value_text(v));
+   FOR i := 0 TO n - 1 DO
+      c := p^[i];
+      IF (c >= 'a') AND (c <= 'z') THEN c := CHR(ORD(c) - 32) END;
+      out[i] := c
+   END;
+   out[n] := 0C;
+   sqlite3_result_text(ctx, out, n, TransientDestr())
+END shout;
+
+(* incbig(x) = x+1 in 64 bits *)
+PROCEDURE incbig (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_int64(ctx, sqlite3_value_int64(ArgAt(argv, 0)) + 1)
+END incbig;
+
+(* echoblob(x) passes bytes through *)
+PROCEDURE echoblob (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR v: ValueHandle;
+BEGIN
+   v := ArgAt(argv, 0);
+   sqlite3_result_blob(ctx, sqlite3_value_blob(v),
+                       sqlite3_value_bytes(v), TransientDestr())
+END echoblob;
+
+(* typenum / numtype expose the type codes *)
+PROCEDURE typenum (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_int(ctx, sqlite3_value_type(ArgAt(argv, 0)))
+END typenum;
+
+PROCEDURE numtype (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_int(ctx, sqlite3_value_numeric_type(ArgAt(argv, 0)))
+END numtype;
+
+(* nullifneg returns NULL or the value itself *)
+PROCEDURE nullifneg (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR v: ValueHandle;
+BEGIN
+   v := ArgAt(argv, 0);
+   IF sqlite3_value_int(v) < 0 THEN
+      sqlite3_result_null(ctx)
+   ELSE
+      sqlite3_result_value(ctx, v)
+   END
+END nullifneg;
+
+(* failcode reports an error with a chosen code *)
+PROCEDURE failcode (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_error_code(ctx, SQLiteTooBig);
+   sqlite3_result_error(ctx, "boom", -1)
+END failcode;
+
+PROCEDURE bigerr (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_error_toobig(ctx)
+END bigerr;
+
+PROCEDURE nomem (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_error_nomem(ctx)
+END nomem;
+
+(* fixed-size results *)
+PROCEDURE zb8 (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_zeroblob(ctx, 8)
+END zb8;
+
+PROCEDURE zb64 (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR rc: INTEGER;
+BEGIN
+   rc := sqlite3_result_zeroblob64(ctx, VAL(LONGCARD, 12));
+   IF rc # SQLiteOk THEN sqlite3_result_error(ctx, "zb64", -1) END
+END zb64;
+
+PROCEDURE b64 (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR v: ValueHandle;
+BEGIN
+   v := ArgAt(argv, 0);
+   sqlite3_result_blob64(ctx, sqlite3_value_blob(v),
+                         VAL(LONGCARD, sqlite3_value_bytes(v)),
+                         TransientDestr())
+END b64;
+
+PROCEDURE t64 (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+BEGIN
+   sqlite3_result_text64(ctx, "hi", VAL(LONGCARD, 2),
+                         TransientDestr(), SQLiteUtf8)
+END t64;
+
+(* msum aggregate: state in aggregate_context, count via userdata *)
+PROCEDURE sumStep (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR s: SumPtr; c: CntPtr; v: ValueHandle;
+BEGIN
+   s := VAL(SumPtr, sqlite3_aggregate_context(ctx, 8));
+   c := VAL(CntPtr, sqlite3_user_data(ctx));
+   c^ := c^ + 1;
+   IF sqlite3_context_db_handle(ctx) # db THEN dbBad := TRUE END;
+   v := ArgAt(argv, 0);
+   IF sqlite3_value_type(v) # SQLiteNull THEN
+      s^ := s^ + sqlite3_value_int64(v)
+   END
+END sumStep;
+
+PROCEDURE sumFinal (ctx: ContextHandle);
+VAR s: SumPtr;
+BEGIN
+   s := VAL(SumPtr, sqlite3_aggregate_context(ctx, 0));
+   sqlite3_result_int64(ctx, s^)
+END sumFinal;
+
+(* auxdata set/get round trip *)
+PROCEDURE auxdemo (ctx: ContextHandle; argc: INTEGER; argv: ADDRESS);
+VAR got: ADDRESS;
+BEGIN
+   IF sqlite3_get_auxdata(ctx, 0) = NIL THEN
+      sqlite3_set_auxdata(ctx, 0, ADR(auxSlot), NIL)
+   END;
+   got := sqlite3_get_auxdata(ctx, 0);
+   IF got # ADR(auxSlot) THEN
+      sqlite3_result_error(ctx, "auxdata lost", -1);
+      RETURN
+   END;
+   sqlite3_result_int(ctx, sqlite3_value_int(ArgAt(argv, 0)) * 10)
+END auxdemo;
+
+VAR
+   rc, i: INTEGER; li: LONGINT; d: REAL;
+   buf: ARRAY [0..63] OF CHAR;
+
+BEGIN
+   stepCalls := 0; dbBad := FALSE; auxSlot := NIL;
+   check(sqlite3_open(":memory:", db), "open");
+   check(sqlite3_create_function(db, "dbl", 1, SQLiteUtf8, NIL,
+                                 dbl, NIL, NIL), "reg dbl");
+   check(sqlite3_create_function(db, "dblany", -1, SQLiteUtf8, NIL,
+                                 dbl, NIL, NIL), "reg dblany");
+   check(sqlite3_create_function_v2(db, "shout", 1,
+                                    SQLiteUtf8 + SQLiteDeterministic,
+                                    NIL, shout, NIL, NIL, NIL),
+         "reg shout");
+   check(sqlite3_create_function(db, "incbig", 1, SQLiteUtf8, NIL,
+                                 incbig, NIL, NIL), "reg incbig");
+   check(sqlite3_create_function(db, "echoblob", 1, SQLiteUtf8, NIL,
+                                 echoblob, NIL, NIL), "reg echoblob");
+   check(sqlite3_create_function(db, "typenum", 1, SQLiteUtf8, NIL,
+                                 typenum, NIL, NIL), "reg typenum");
+   check(sqlite3_create_function(db, "numtype", 1, SQLiteUtf8, NIL,
+                                 numtype, NIL, NIL), "reg numtype");
+   check(sqlite3_create_function(db, "nullifneg", 1, SQLiteUtf8, NIL,
+                                 nullifneg, NIL, NIL), "reg nullifneg");
+   check(sqlite3_create_function(db, "failcode", 0, SQLiteUtf8, NIL,
+                                 failcode, NIL, NIL), "reg failcode");
+   check(sqlite3_create_function(db, "bigerr", 0, SQLiteUtf8, NIL,
+                                 bigerr, NIL, NIL), "reg bigerr");
+   check(sqlite3_create_function(db, "nomem", 0, SQLiteUtf8, NIL,
+                                 nomem, NIL, NIL), "reg nomem");
+   check(sqlite3_create_function(db, "zb8", 0, SQLiteUtf8, NIL,
+                                 zb8, NIL, NIL), "reg zb8");
+   check(sqlite3_create_function(db, "zb64", 0, SQLiteUtf8, NIL,
+                                 zb64, NIL, NIL), "reg zb64");
+   check(sqlite3_create_function(db, "b64", 1, SQLiteUtf8, NIL,
+                                 b64, NIL, NIL), "reg b64");
+   check(sqlite3_create_function(db, "t64", 0, SQLiteUtf8, NIL,
+                                 t64, NIL, NIL), "reg t64");
+   check(sqlite3_create_function(db, "msum", 1, SQLiteUtf8,
+                                 ADR(stepCalls), NIL,
+                                 sumStep, sumFinal), "reg msum");
+   check(sqlite3_create_function(db, "auxdemo", 1, SQLiteUtf8, NIL,
+                                 auxdemo, NIL, NIL), "reg auxdemo");
+
+   oneRow("SELECT dbl(21.0);", "dbl prep");
+   d := sqlite3_column_double(stmt, 0);
+   printf("dbl %f\n", d);
+   IF (d < 41.9) OR (d > 42.1) THEN fail("dbl value") END;
+   endRow("dbl");
+
+   oneRow("SELECT shout('hello');", "shout prep");
+   CStrToM2(sqlite3_column_text(stmt, 0), buf);
+   printf("shout %s\n", buf);
+   IF buf[0] # 'H' THEN fail("shout value") END;
+   endRow("shout");
+
+   oneRow("SELECT incbig(9000000000);", "incbig prep");
+   li := sqlite3_column_int64(stmt, 0);
+   printf("incbig %ld\n", li);
+   IF li # VAL(LONGINT, 9000000001) THEN fail("incbig value") END;
+   endRow("incbig");
+
+   oneRow("SELECT echoblob(X'ABCD') = X'ABCD';", "echoblob prep");
+   IF sqlite3_column_int(stmt, 0) # 1 THEN fail("echoblob value") END;
+   endRow("echoblob");
+
+   oneRow("SELECT typenum(1), typenum('a'), typenum(NULL),"
+          + " numtype('123'), numtype(1.5);", "types prep");
+   IF sqlite3_column_int(stmt, 0) # SQLiteInteger THEN fail("t int") END;
+   IF sqlite3_column_int(stmt, 1) # SQLiteText THEN fail("t text") END;
+   IF sqlite3_column_int(stmt, 2) # SQLiteNull THEN fail("t null") END;
+   IF sqlite3_column_int(stmt, 3) # SQLiteInteger THEN fail("nt") END;
+   IF sqlite3_column_int(stmt, 4) # 2 THEN fail("nt float") END;
+   printf("types ok\n");
+   endRow("types");
+
+   oneRow("SELECT nullifneg(-5) IS NULL, nullifneg(7);", "null prep");
+   IF sqlite3_column_int(stmt, 0) # 1 THEN fail("null isnull") END;
+   IF sqlite3_column_int(stmt, 1) # 7 THEN fail("null passthru") END;
+   endRow("null");
+
+   oneRow("SELECT LENGTH(zb8()), LENGTH(zb64()),"
+          + " LENGTH(b64(X'0102')), t64();", "zeros prep");
+   IF sqlite3_column_int(stmt, 0) # 8 THEN fail("zb8") END;
+   IF sqlite3_column_int(stmt, 1) # 12 THEN fail("zb64") END;
+   IF sqlite3_column_int(stmt, 2) # 2 THEN fail("b64") END;
+   CStrToM2(sqlite3_column_text(stmt, 3), buf);
+   IF buf[0] # 'h' THEN fail("t64") END;
+   printf("sized results ok\n");
+   endRow("zeros");
+
+   oneRow("SELECT msum(column1) FROM (VALUES (1),(2),(3));",
+          "msum prep");
+   li := sqlite3_column_int64(stmt, 0);
+   printf("msum %ld calls %d\n", li, stepCalls);
+   IF li # 6 THEN fail("msum value") END;
+   IF stepCalls # 3 THEN fail("msum userdata") END;
+   IF dbBad THEN fail("db handle") END;
+   endRow("msum");
+
+   oneRow("SELECT auxdemo(5);", "aux prep");
+   IF sqlite3_column_int(stmt, 0) # 50 THEN fail("aux value") END;
+   endRow("aux");
+
+   (* error paths: each must fail the step with a message *)
+   check(sqlite3_prepare_v2(db, "SELECT dblany();", -1, stmt, NIL),
+         "err prep");
+   rc := sqlite3_step(stmt);
+   CStrToM2(sqlite3_errmsg(db), buf);
+   printf("dblany rc %d err %s\n", rc, buf);
+   IF rc = SQLiteOk THEN fail("dblany ok") END;
+   IF buf[0] = 0C THEN fail("dblany msg") END;
+   rc := sqlite3_finalize(stmt);
+   IF rc = SQLiteOk THEN fail("dblany fin") END;
+
+   FOR i := 0 TO 2 DO
+      IF i = 0 THEN errCase("SELECT failcode();", i)
+      ELSIF i = 1 THEN errCase("SELECT bigerr();", i)
+      ELSE errCase("SELECT nomem();", i)
+      END
+   END;
+
+   check(sqlite3_close(db), "close");
+   printf("PASS test_func\n")
+END test_func.