M2compiler-V3/bindings/sqlite3/tests/SQLiteErrors.mod

MODULE SQLiteErrors;
(* Error codes, errmsg/errstr, extended codes and sqlite3_free. *)

FROM SYSTEM IMPORT ADDRESS;
FROM CStr IMPORT CString, Copy;
FROM SQLite IMPORT
  SQLiteOk, SQLiteConstraint, SQLiteConstraintPrimaryKey,
  sqlite3_open, sqlite3_exec, sqlite3_close,
  sqlite3_errcode, sqlite3_extended_errcode,
  sqlite3_extended_result_codes, sqlite3_errmsg, sqlite3_errstr,
  sqlite3_free;

VAR
  ExitCode : INTEGER;
  db : ADDRESS;
  errmsg : ADDRESS;
  svalue : CString;
  buf : ARRAY [0..127] OF CHAR;
  rc : INTEGER;
  ok : BOOLEAN;

BEGIN
  ExitCode := 1;
  db := NIL; errmsg := NIL; ok := FALSE;
  IF sqlite3_open(":memory:", db) = SQLiteOk THEN
    IF (sqlite3_extended_result_codes(db, 1) = SQLiteOk)
       AND (sqlite3_exec(db, "CREATE TABLE u(x INTEGER PRIMARY KEY);",
                         NIL, NIL, errmsg) = SQLiteOk) THEN
      IF sqlite3_exec(db, "INSERT INTO u VALUES (1);",
                      NIL, NIL, errmsg) = SQLiteOk THEN
        errmsg := NIL;
        rc := sqlite3_exec(db, "INSERT INTO u VALUES (1);",
                           NIL, NIL, errmsg);
        IF (rc = SQLiteConstraintPrimaryKey)
           AND (sqlite3_errcode(db) = SQLiteConstraintPrimaryKey)
           AND (sqlite3_extended_errcode(db) = SQLiteConstraintPrimaryKey) THEN
          svalue := sqlite3_errmsg(db);
          IF (svalue # NIL) AND (Copy(svalue, buf) > 0) AND (buf[0] # CHR(0)) THEN
            svalue := sqlite3_errstr(SQLiteConstraint);
            IF (svalue # NIL) AND (Copy(svalue, buf) > 0)
               AND (buf[0] # CHR(0)) THEN
              ok := TRUE
            END
          END
        END;
        IF errmsg # NIL THEN
          svalue := errmsg;
          IF (Copy(svalue, buf) = 0) OR (buf[0] = CHR(0)) THEN
            ok := FALSE
          END;
          sqlite3_free(errmsg);
          errmsg := NIL
        ELSE
          ok := FALSE
        END
      END
    END
  END;
  IF db # NIL THEN
    IF sqlite3_close(db) # SQLiteOk THEN ok := FALSE END
  END;
  IF ok THEN ExitCode := 42 END
END SQLiteErrors.