Merge remote-tracking branch 'origin/master' into feature/package+vc

1 files changed, 41 insertions, 31 deletions

diff --git a/src/sqlite.c b/src/sqlite.c
index 1526e344e53..08bf696b8ca 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -50,6 +50,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_extended_errcode, (sqlite3*));
 DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
 DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
 DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
@@ -88,6 +89,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
 # undef sqlite3_bind_double
 # undef sqlite3_bind_null
 # undef sqlite3_bind_int
+# undef sqlite3_extended_errcode
 # undef sqlite3_errmsg
 # undef sqlite3_errstr
 # undef sqlite3_step
@@ -113,6 +115,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
 # define sqlite3_bind_double fn_sqlite3_bind_double
 # define sqlite3_bind_null fn_sqlite3_bind_null
 # define sqlite3_bind_int fn_sqlite3_bind_int
+# define sqlite3_extended_errcode fn_sqlite3_extended_errcode
 # define sqlite3_errmsg fn_sqlite3_errmsg
 # define sqlite3_errstr fn_sqlite3_errstr
 # define sqlite3_step fn_sqlite3_step
@@ -141,6 +144,7 @@ load_dll_functions (HMODULE library)
   LOAD_DLL_FN (library, sqlite3_bind_double);
   LOAD_DLL_FN (library, sqlite3_bind_null);
   LOAD_DLL_FN (library, sqlite3_bind_int);
+  LOAD_DLL_FN (library, sqlite3_extended_errcode);
   LOAD_DLL_FN (library, sqlite3_errmsg);
   LOAD_DLL_FN (library, sqlite3_errstr);
   LOAD_DLL_FN (library, sqlite3_step);
@@ -233,13 +237,13 @@ check_sqlite (Lisp_Object db, bool is_statement)
   init_sqlite_functions ();
   CHECK_SQLITE (db);
   if (is_statement && !XSQLITE (db)->is_statement)
-    xsignal1 (Qerror, build_string ("Invalid set object"));
+    xsignal1 (Qsqlite_error, build_string ("Invalid set object"));
   else if (!is_statement && XSQLITE (db)->is_statement)
-    xsignal1 (Qerror, build_string ("Invalid database object"));
+    xsignal1 (Qsqlite_error, build_string ("Invalid database object"));
   if (!is_statement && !XSQLITE (db)->db)
-    xsignal1 (Qerror, build_string ("Database closed"));
+    xsignal1 (Qsqlite_error, build_string ("Database closed"));
   else if (is_statement && !XSQLITE (db)->db)
-    xsignal1 (Qerror, build_string ("Statement closed"));
+    xsignal1 (Qsqlite_error, build_string ("Statement closed"));
 }
 
 static int db_count = 0;
@@ -259,7 +263,7 @@ If FILE is nil, an in-memory database will be opened instead.  */)
 #endif
 
   if (!init_sqlite_functions ())
-    xsignal1 (Qerror, build_string ("sqlite support is not available"));
+    xsignal1 (Qsqlite_error, build_string ("sqlite support is not available"));
 
   if (!NILP (file))
     name = ENCODE_FILE (Fexpand_file_name (file, Qnil));
@@ -272,7 +276,7 @@ If FILE is nil, an in-memory database will be opened instead.  */)
       name = CALLN (Fformat, memory_fmt, make_int (++db_count));
       flags |= SQLITE_OPEN_MEMORY;
 #else
-      xsignal1 (Qerror, build_string ("sqlite in-memory is not available"));
+      xsignal1 (Qsqlite_error, build_string ("sqlite in-memory is not available"));
 #endif
     }
 
@@ -342,7 +346,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
           if (blob)
             {
               if (SBYTES (value) != SCHARS (value))
-                xsignal1 (Qerror, build_string ("BLOB values must be unibyte"));
+                xsignal1 (Qsqlite_error, build_string ("BLOB values must be unibyte"));
             ret = sqlite3_bind_blob (stmt, i + 1,
                                        SSDATA (value), SBYTES (value),
                                        NULL);
@@ -422,16 +426,15 @@ row_to_value (sqlite3_stmt *stmt)
 }
 
 static Lisp_Object
-sqlite_prepare_errmsg (int code, sqlite3 *sdb)
+sqlite_prepare_errdata (int code, sqlite3 *sdb)
 {
-  Lisp_Object errmsg = build_string (sqlite3_errstr (code));
+  Lisp_Object errstr = build_string (sqlite3_errstr (code));
+  Lisp_Object errcode = make_fixnum (code);
   /* More details about what went wrong.  */
-  const char *sql_error = sqlite3_errmsg (sdb);
-  if (sql_error)
-    return CALLN (Fformat, build_string ("%s (%s)"),
-                  errmsg, build_string (sql_error));
-  else
-    return errmsg;
+  Lisp_Object ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
+  const char *errmsg = sqlite3_errmsg (sdb);
+  return list4 (errstr, errmsg ? build_string (errmsg) : Qnil,
+                errcode, ext_errcode);
 }
 
 DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
@@ -447,7 +450,7 @@ Value is the number of affected rows.  */)
   check_sqlite (db, false);
   CHECK_STRING (query);
   if (!(NILP (values) || CONSP (values) || VECTORP (values)))
-    xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+    xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));
 
   sqlite3 *sdb = XSQLITE (db)->db;
   Lisp_Object errmsg = Qnil,
@@ -466,7 +469,7 @@ Value is the number of affected rows.  */)
           sqlite3_reset (stmt);
         }
 
-      errmsg = sqlite_prepare_errmsg (ret, sdb);
+      errmsg = sqlite_prepare_errdata (ret, sdb);
       goto exit;
     }
 
@@ -505,7 +508,7 @@ Value is the number of affected rows.  */)
  exit:
   sqlite3_finalize (stmt);
   xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
-            Qsqlite_locked_error: Qerror,
+            Qsqlite_locked_error: Qsqlite_error,
             errmsg);
 }
 
@@ -525,14 +528,15 @@ DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0,
 If VALUES is non-nil, it should be a list or a vector specifying the
 values that will be interpolated into a parameterized statement.
 
-By default, the return value is a list where the first element is a
-list of column names, and the rest of the elements are the matching data.
+By default, the return value is a list, whose contents depend on
+the value of the optional argument RETURN-TYPE.
 
-RETURN-TYPE can be either nil (which means that the matching data
-should be returned as a list of rows), or `full' (the same, but the
-first element in the return list will be the column names), or `set',
-which means that we return a set object that can be queried with
-`sqlite-next' and other functions to get the data.  */)
+If RETURN-TYPE is nil or omitted, the function returns a list of rows
+matching QUERY.  If RETURN-TYPE is `full', the function returns a
+list whose first element is the list of column names, and the rest
+of the elements are the rows matching QUERY.  If RETURN-TYPE is `set',
+the function returns a set object that can be queried with functions
+like `sqlite-next' etc., in order to get the data.  */)
   (Lisp_Object db, Lisp_Object query, Lisp_Object values,
    Lisp_Object return_type)
 {
@@ -540,7 +544,7 @@ which means that we return a set object that can be queried with
   CHECK_STRING (query);
 
   if (!(NILP (values) || CONSP (values) || VECTORP (values)))
-    xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+    xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));
 
   sqlite3 *sdb = XSQLITE (db)->db;
   Lisp_Object retval = Qnil, errmsg = Qnil,
@@ -553,7 +557,7 @@ which means that we return a set object that can be queried with
     {
       if (stmt)
         sqlite3_finalize (stmt);
-      errmsg = sqlite_prepare_errmsg (ret, sdb);
+      errmsg = sqlite_prepare_errdata (ret, sdb);
       goto exit;
     }
 
@@ -589,7 +593,7 @@ which means that we return a set object that can be queried with
 
  exit:
   if (! NILP (errmsg))
-    xsignal1 (Qerror, errmsg);
+    xsignal1 (Qsqlite_error, errmsg);
 
   return retval;
 }
@@ -675,7 +679,7 @@ Only modules on Emacs' list of allowed modules can be loaded.  */)
     }
 
   if (!do_allow)
-    xsignal (Qerror, build_string ("Module name not on allowlist"));
+    xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
 
   int result = sqlite3_load_extension
                        (XSQLITE (db)->db,
@@ -695,7 +699,7 @@ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
 
   int ret = sqlite3_step (XSQLITE (set)->stmt);
   if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
-    xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
+    xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
 
   if (ret == SQLITE_DONE)
     {
@@ -794,9 +798,15 @@ syms_of_sqlite (void)
   defsubr (&Ssqlitep);
   defsubr (&Ssqlite_available_p);
 
+  DEFSYM (Qsqlite_error, "sqlite-error");
+  Fput (Qsqlite_error, Qerror_conditions,
+        Fpurecopy (list2 (Qsqlite_error, Qerror)));
+  Fput (Qsqlite_error, Qerror_message,
+        build_pure_c_string ("Database error"));
+
   DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
   Fput (Qsqlite_locked_error, Qerror_conditions,
-        Fpurecopy (list2 (Qsqlite_locked_error, Qerror)));
+        Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)));
   Fput (Qsqlite_locked_error, Qerror_message,
         build_pure_c_string ("Database locked"));