SQLITE-m2/tests/test_func.mod

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.