SQLiteConstraints.mod 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. MODULE SQLiteConstraints;
  2. (* Extended constraint result codes:
  3. unique, not-null, primary-key, check and foreign-key failures. *)
  4. FROM SYSTEM IMPORT ADDRESS;
  5. FROM SQLite IMPORT
  6. SQLiteOk, SQLiteConstraint,
  7. SQLiteConstraintUnique, SQLiteConstraintNotNull,
  8. SQLiteConstraintPrimaryKey, SQLiteConstraintCheck,
  9. SQLiteConstraintForeignKey,
  10. SQLiteOpenReadWrite, SQLiteOpenCreate, SQLiteOpenMemory,
  11. sqlite3_open_v2, sqlite3_exec, sqlite3_close_v2,
  12. sqlite3_extended_result_codes, sqlite3_extended_errcode,
  13. sqlite3_free;
  14. VAR
  15. ExitCode : INTEGER;
  16. db : ADDRESS;
  17. rc : INTEGER;
  18. ok : BOOLEAN;
  19. PROCEDURE ExecSQL (sql : ARRAY OF CHAR) : BOOLEAN;
  20. VAR
  21. errmsg : ADDRESS;
  22. good : BOOLEAN;
  23. BEGIN
  24. errmsg := NIL;
  25. good := sqlite3_exec(db, sql, NIL, NIL, errmsg) = SQLiteOk;
  26. IF errmsg # NIL THEN
  27. sqlite3_free(errmsg)
  28. END;
  29. RETURN good
  30. END ExecSQL;
  31. PROCEDURE Expect (sql : ARRAY OF CHAR; code : INTEGER) : BOOLEAN;
  32. VAR
  33. errmsg : ADDRESS;
  34. got : INTEGER;
  35. good : BOOLEAN;
  36. BEGIN
  37. errmsg := NIL;
  38. got := sqlite3_exec(db, sql, NIL, NIL, errmsg);
  39. good := ((got = code) OR (got = SQLiteConstraint))
  40. AND (sqlite3_extended_errcode(db) = code);
  41. IF errmsg # NIL THEN
  42. sqlite3_free(errmsg)
  43. END;
  44. RETURN good
  45. END Expect;
  46. BEGIN
  47. ExitCode := 1;
  48. db := NIL; ok := FALSE;
  49. IF (sqlite3_open_v2(":memory:", db,
  50. SQLiteOpenReadWrite + SQLiteOpenCreate + SQLiteOpenMemory,
  51. NIL) = SQLiteOk) AND (db # NIL)
  52. AND (sqlite3_extended_result_codes(db, 1) = SQLiteOk) THEN
  53. ok := TRUE
  54. END;
  55. IF ok THEN
  56. ok := ExecSQL("CREATE TABLE u(v TEXT UNIQUE);")
  57. AND ExecSQL("INSERT INTO u VALUES('a');")
  58. AND Expect("INSERT INTO u VALUES('a');",
  59. SQLiteConstraintUnique)
  60. END;
  61. IF ok THEN
  62. ok := ExecSQL("CREATE TABLE n(v TEXT NOT NULL);")
  63. AND Expect("INSERT INTO n VALUES(NULL);",
  64. SQLiteConstraintNotNull)
  65. END;
  66. IF ok THEN
  67. ok := ExecSQL("CREATE TABLE p(id INTEGER PRIMARY KEY);")
  68. AND ExecSQL("INSERT INTO p VALUES(1);")
  69. AND Expect("INSERT INTO p VALUES(1);",
  70. SQLiteConstraintPrimaryKey)
  71. END;
  72. IF ok THEN
  73. ok := ExecSQL("CREATE TABLE c(v INTEGER CHECK(v > 0));")
  74. AND Expect("INSERT INTO c VALUES(0);",
  75. SQLiteConstraintCheck)
  76. END;
  77. IF ok THEN
  78. ok := ExecSQL("PRAGMA foreign_keys=ON;")
  79. AND ExecSQL("CREATE TABLE f(pid INTEGER REFERENCES p(id));")
  80. AND Expect("INSERT INTO f VALUES(99);",
  81. SQLiteConstraintForeignKey)
  82. END;
  83. IF db # NIL THEN
  84. IF sqlite3_close_v2(db) # SQLiteOk THEN ok := FALSE END
  85. END;
  86. IF ok THEN ExitCode := 42 END
  87. END SQLiteConstraints.