MODULE SQLiteBlob;
(* BLOB storage and access:
   bind_blob, bind_zeroblob, column_blob, column_bytes,
   incremental blob_open/read/write/bytes/reopen/close. *)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM SQLite IMPORT
  SQLiteOk, SQLiteRow, SQLiteDone, SQLiteBlob,
  SQLiteOpenReadOnly, SQLiteOpenReadWrite, SQLiteOpenCreate,
  SQLiteOpenMemory,
  sqlite3_open_v2, sqlite3_exec, sqlite3_close_v2,
  sqlite3_prepare_v2, sqlite3_bind_blob, sqlite3_bind_zeroblob,
  sqlite3_step, sqlite3_reset, sqlite3_clear_bindings,
  sqlite3_column_type, sqlite3_column_bytes, sqlite3_column_blob,
  sqlite3_finalize,
  sqlite3_changes, sqlite3_total_changes, sqlite3_last_insert_rowid,
  sqlite3_blob_open, sqlite3_blob_close, sqlite3_blob_read,
  sqlite3_blob_write, sqlite3_blob_bytes, sqlite3_blob_reopen,
  sqlite3_free, SQLiteTransient;

VAR
  ExitCode : INTEGER;
  db, stmt, blob, p : ADDRESS;
  bin, out : ARRAY [0..7] OF CHAR;
  rc : INTEGER;
  ok : BOOLEAN;

PROCEDURE ExecSQL (sql : ARRAY OF CHAR) : BOOLEAN;
VAR
  errmsg : ADDRESS;
  good : BOOLEAN;
BEGIN
  errmsg := NIL;
  good := sqlite3_exec(db, sql, NIL, NIL, errmsg) = SQLiteOk;
  IF errmsg # NIL THEN
    sqlite3_free(errmsg)
  END;
  RETURN good
END ExecSQL;

PROCEDURE SameBytes (a, b : ARRAY OF CHAR; n : INTEGER) : BOOLEAN;
VAR
  i : INTEGER;
BEGIN
  i := 0;
  WHILE (i < n) AND (a[i] = b[i]) DO
    i := i + 1
  END;
  RETURN i = n
END SameBytes;

PROCEDURE FinishStmt;
BEGIN
  IF stmt # NIL THEN
    IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
    stmt := NIL
  END
END FinishStmt;

BEGIN
  ExitCode := 1;
  db := NIL; stmt := NIL; blob := NIL; p := NIL;
  ok := 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 ExecSQL("CREATE TABLE b(id INTEGER PRIMARY KEY, data BLOB);") THEN
      rc := sqlite3_prepare_v2(db,
        "INSERT INTO b(data) VALUES (?);", -1, stmt, NIL);
      ok := (rc = SQLiteOk) AND (stmt # NIL);

      (* 5-byte binary value, including an embedded NUL.  ADR(bin[0])
         skips the V3 array descriptor and passes the first data byte. *)
      IF ok THEN
        ok := sqlite3_bind_blob(stmt, 1, ADR(bin[0]), 5,
                                SQLiteTransient()) = SQLiteOk
      END;
      IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
      IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
      IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;

      (* Legitimate zero-length BLOB, distinct from NULL. *)
      IF ok THEN
        ok := sqlite3_bind_blob(stmt, 1, ADR(bin[0]), 0,
                                SQLiteTransient()) = SQLiteOk
      END;
      IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
      IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
      IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;

      (* Eight zero bytes for incremental BLOB I/O. *)
      IF ok THEN ok := sqlite3_bind_zeroblob(stmt, 1, 8) = SQLiteOk END;
      IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
      FinishStmt;

      IF ok THEN
        ok := (sqlite3_changes(db) = 1)
              AND (sqlite3_total_changes(db) = 3)
              AND (sqlite3_last_insert_rowid(db) = 3)
      END
    END
  END;

  (* Read the binary BLOB column metadata. *)
  IF ok THEN
    rc := sqlite3_prepare_v2(db,
      "SELECT data FROM b WHERE id = 1;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL);
    IF ok THEN
      ok := sqlite3_step(stmt) = SQLiteRow;
      IF ok THEN
        ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
              AND (sqlite3_column_bytes(stmt, 0) = 5);
        p := sqlite3_column_blob(stmt, 0);
        IF p = NIL THEN ok := FALSE END;
        IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
      END
    END;
    FinishStmt
  END;

  (* Verify the bound bytes through a read-only incremental BLOB. *)
  IF ok THEN
    rc := sqlite3_blob_open(db, "main", "b", "data", 1,
                            SQLiteOpenReadOnly, blob);
    ok := (rc = SQLiteOk) AND (blob # NIL)
  END;
  IF ok THEN ok := sqlite3_blob_bytes(blob) = 5 END;
  IF ok THEN
    ok := sqlite3_blob_read(blob, ADR(out[0]), 5, 0) = SQLiteOk
  END;
  IF ok THEN ok := SameBytes(bin, out, 5) END;
  IF blob # NIL THEN
    IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END;
    blob := NIL
  END;

  (* A zero-length BLOB reports SQLiteBlob with zero bytes. *)
  IF ok THEN
    rc := sqlite3_prepare_v2(db,
      "SELECT data FROM b WHERE id = 2;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL);
    IF ok THEN
      ok := sqlite3_step(stmt) = SQLiteRow;
      IF ok THEN
        ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
              AND (sqlite3_column_bytes(stmt, 0) = 0);
        IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
      END
    END;
    FinishStmt
  END;

  (* Incremental BLOB I/O on the zeroblob row. *)
  IF ok THEN
    rc := sqlite3_blob_open(db, "main", "b", "data", 3,
                            SQLiteOpenReadWrite, blob);
    ok := (rc = SQLiteOk) AND (blob # NIL)
  END;
  IF ok THEN ok := sqlite3_blob_bytes(blob) = 8 END;
  IF ok THEN
    ok := sqlite3_blob_write(blob, ADR(bin[0]), 5, 0) = SQLiteOk
  END;
  IF ok THEN
    ok := sqlite3_blob_read(blob, ADR(out[0]), 5, 0) = SQLiteOk
  END;
  IF ok THEN ok := SameBytes(bin, out, 5) END;
  IF ok THEN ok := sqlite3_blob_reopen(blob, 3) = SQLiteOk END;
  IF blob # NIL THEN
    IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END;
    blob := NIL
  END;

  (* The write survives closing the incremental BLOB handle. *)
  IF ok THEN
    rc := sqlite3_prepare_v2(db,
      "SELECT data FROM b WHERE id = 3;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL);
    IF ok THEN
      ok := sqlite3_step(stmt) = SQLiteRow;
      IF ok THEN
        ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
              AND (sqlite3_column_bytes(stmt, 0) = 8);
        IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
      END
    END;
    FinishStmt
  END;

  FinishStmt;
  IF blob # NIL THEN
    IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END
  END;
  IF db # NIL THEN
    IF sqlite3_close_v2(db) # SQLiteOk THEN ok := FALSE END
  END;
  IF ok THEN ExitCode := 42 END
END SQLiteBlob.