SQLITE-m2/tests/test_codes.mod

MODULE test_codes ;

(*
   m2SQLITE test: extended result codes and the get_table family.
   Triggers unique, not-null, primary-key and foreign-key violations
   and checks the exact extended codes, then reads a result table
   through the raw binding and the GetTable helpers.
*)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM SQLite IMPORT DbHandle,
   SQLiteOk,
   SQLiteConstraintUnique, SQLiteConstraintNotNull,
   SQLiteConstraintPrimaryKey, SQLiteConstraintForeignKey,
   sqlite3_open, sqlite3_close,
   sqlite3_extended_result_codes, sqlite3_extended_errcode,
   sqlite3_get_table, sqlite3_free_table;
FROM SQLiteUtils IMPORT ErrMsg, ExecSimple,
   GetTable, TableCell, FreeTable;
FROM libc IMPORT printf;

VAR
   db: DbHandle;
   tbl: ADDRESS; msg: ADDRESS;
   rows, cols, rc: INTEGER;
   buf: ARRAY [0..127] OF CHAR;

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 expect (sql: ARRAY OF CHAR; code: INTEGER; tag: ARRAY OF CHAR);
VAR rc: INTEGER;
BEGIN
   rc := ExecSimple(db, sql);
   printf("%s rc %d\n", tag, rc);
   IF rc # code THEN fail(tag) END;
   IF sqlite3_extended_errcode(db) # code THEN fail(tag) END
END expect;

BEGIN
   check(sqlite3_open(":memory:", db), "open");
   check(sqlite3_extended_result_codes(db, 1), "ext on");
   check(ExecSimple(db, "CREATE TABLE u(v TEXT UNIQUE);"), "uniq tab");
   check(ExecSimple(db, "INSERT INTO u VALUES('a');"), "uniq seed");
   expect("INSERT INTO u VALUES('a');",
          SQLiteConstraintUnique, "unique");
   check(ExecSimple(db, "CREATE TABLE n(v TEXT NOT NULL);"), "nn tab");
   expect("INSERT INTO n VALUES(NULL);",
          SQLiteConstraintNotNull, "notnull");
   check(ExecSimple(db, "CREATE TABLE p(id INTEGER PRIMARY KEY);"),
         "pk tab");
   check(ExecSimple(db, "INSERT INTO p VALUES(1);"), "pk seed");
   expect("INSERT INTO p VALUES(1);",
          SQLiteConstraintPrimaryKey, "primarykey");
   check(ExecSimple(db, "PRAGMA foreign_keys=ON;"), "fk pragma");
   check(ExecSimple(db, "CREATE TABLE ch(pid INTEGER"
                        + " REFERENCES p(id));"), "fk tab");
   expect("INSERT INTO ch VALUES(2);",
          SQLiteConstraintForeignKey, "foreignkey");
   printf("extended codes ok\n");

   (* raw binding call *)
   check(ExecSimple(db, "CREATE TABLE t(a TEXT, b INTEGER);"), "t tab");
   check(ExecSimple(db, "INSERT INTO t VALUES('x', 1),"
                        + "(NULL, 2), ('z', 3);"), "t seed");
   tbl := NIL; rows := 0; cols := 0; msg := NIL;
   rc := sqlite3_get_table(db, "SELECT a, b FROM t ORDER BY b;",
                           tbl, rows, cols, ADR(msg));
   IF rc # SQLiteOk THEN fail("raw get_table") END;
   IF msg # NIL THEN fail("raw errmsg set") END;
   IF (rows # 3) OR (cols # 2) THEN fail("raw dims") END;
   TableCell(tbl, cols, -1, 0, buf);
   IF buf[0] # 'a' THEN fail("raw header") END;
   TableCell(tbl, cols, 1, 0, buf);
   IF buf[0] # 0C THEN fail("raw null cell") END;
   TableCell(tbl, cols, 2, 0, buf);
   IF buf[0] # 'z' THEN fail("raw cell") END;
   TableCell(tbl, cols, 0, 1, buf);
   IF buf[0] # '1' THEN fail("raw int cell") END;
   FreeTable(tbl);
   printf("raw table ok\n");

   (* helper path, including the failing-statement branch *)
   check(GetTable(db, "SELECT a FROM t WHERE b = 3;",
                  tbl, rows, cols, buf), "helper table");
   IF (rows # 1) OR (cols # 1) THEN fail("helper dims") END;
   TableCell(tbl, cols, 0, 0, buf);
   printf("helper cell %s\n", buf);
   IF buf[0] # 'z' THEN fail("helper cell") END;
   FreeTable(tbl);
   rc := GetTable(db, "SELECT * FROM bogus;", tbl, rows, cols, buf);
   printf("helper bad rc %d err %s\n", rc, buf);
   IF rc = SQLiteOk THEN fail("helper bad ok") END;
   IF buf[0] = 0C THEN fail("helper bad msg") END;
   IF tbl # NIL THEN fail("helper bad table") END;

   check(sqlite3_close(db), "close");
   printf("PASS test_codes\n")
END test_codes.