[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3d38d1d: Add sqlite3 support to Emacs
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 3d38d1d: Add sqlite3 support to Emacs |
|
Date: |
Fri, 10 Dec 2021 22:56:15 -0500 (EST) |
branch: master
commit 3d38d1d1345aa65c4018b42e6c648606e32216f8
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add sqlite3 support to Emacs
* configure.ac: Add check for the sqlite library.
* doc/lispref/text.texi (Database): Document it.
* lisp/sqlite.el: New file.
* lisp/term/w32-win.el (dynamic-library-alist): Add a mapping.
* src/Makefile.in (SQLITE3_LIBS): Add the libraries.
* src/alloc.c (union emacs_align_type): Add a Lisp_Sqlite struct.
* src/data.c (Ftype_of): Add sqlite.
* src/emacs.c (main): Load the syms.
* src/lisp.h (DEFINE_GDB_SYMBOL_BEGIN): Add PVEC_SQLITE.
(GCALIGNED_STRUCT): New struct to keep data for sqlite database
objects and statement objects.
(SQLITEP, SQLITE, CHECK_SQLITE, XSQLITE): New macros for accessing
the objects.
* src/pdumper.c (dump_vectorlike): Update hash.
(dump_vectorlike): Don't dump it.
* src/print.c (print_vectorlike): Add a printer for the sqlite
object.
* src/sqlite.c: New file.
* test/src/sqlite-tests.el: Add tests.
---
admin/CPP-DEFINES | 1 +
configure.ac | 20 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/text.texi | 146 ++++++++++
lisp/sqlite.el | 42 +++
lisp/term/w32-win.el | 1 +
src/Makefile.in | 7 +-
src/alloc.c | 1 +
src/data.c | 2 +
src/emacs.c | 1 +
src/lisp.h | 40 +++
src/pdumper.c | 4 +-
src/print.c | 16 ++
src/sqlite.c | 708 +++++++++++++++++++++++++++++++++++++++++++++++
test/src/sqlite-tests.el | 175 ++++++++++++
15 files changed, 1161 insertions(+), 4 deletions(-)
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 634d6f3..620ab0b 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -288,6 +288,7 @@ HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
HAVE_WEBP
+HAVE_SQLITE3
HAVE_WCHAR_H
HAVE_WCHAR_T
HAVE_WINDOW_SYSTEM
diff --git a/configure.ac b/configure.ac
index 0c23b60..5eb2384 100644
--- a/configure.ac
+++ b/configure.ac
@@ -448,6 +448,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image
support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_ON([webp],[don't compile with WebP image support])
+OPTION_DEFAULT_ON([sqlite3],[don't compile with sqlite3 support])
OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support])
OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing])
@@ -2681,6 +2682,22 @@ if test "${with_webp}" != "no"; then
fi
fi
+### Use -lsqlite3 if available, unless '--with-sqlite3=no'
+HAVE_SQLITE3=no
+if test "${with_sqlite3}" != "no"; then
+ AC_CHECK_LIB(sqlite3, sqlite3_open_v2, HAVE_SQLITE3=yes, HAVE_SQLITE3=no)
+ if test "$HAVE_SQLITE3" = "yes"; then
+ SQLITE3_LIBS=-lsqlite3
+ AC_SUBST(SQLITE3_LIBS)
+ LIBS="$SQLITE3_LIBS $LIBS"
+ AC_DEFINE(HAVE_SQLITE3, 1, [Define to 1 if you have the libsqlite3
library (-lsqlite).])
+ # Windows loads libwebp dynamically
+ if test "${opsys}" = "mingw32"; then
+ SQLITE3_LIBS=
+ fi
+ fi
+fi
+
HAVE_IMAGEMAGICK=no
if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test
"${HAVE_W32}" = "yes" || \
test "${HAVE_BE_APP}" = "yes"; then
@@ -6155,7 +6172,7 @@ emacs_config_features=
for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM
GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
- SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \
+ SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS \
UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \
ZLIB; do
@@ -6202,6 +6219,7 @@ AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D
Does Emacs use a png library? ${HAVE_PNG} $LIBPNG
Does Emacs use -lrsvg-2? ${HAVE_RSVG}
Does Emacs use -lwebp? ${HAVE_WEBP}
+ Does Emacs use -lsqlite3? ${HAVE_SQLITE3}
Does Emacs use cairo? ${HAVE_CAIRO}
Does Emacs use -llcms2? ${HAVE_LCMS2}
Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 4f47a1d..b773ba8 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1224,6 +1224,7 @@ Text
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
+* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 03adb54..e964d7b 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -60,6 +60,7 @@ the character after point.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
+* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Parsing JSON:: Parsing and generating JSON values.
* JSONRPC:: JSON Remote Procedure Call protocol
@@ -5135,6 +5136,151 @@ On success, it returns a list of a binary string (the
output) and the
IV used.
@end defun
+@node Database
+@section Database
+
+ Emacs can be compiled with built-in SQLite support.
+
+@defun sqlite-available-p
+The function returns non-@code{nil} if built-in SQLite support is
+available in this Emacs session.
+@end defun
+
+When SQLite support is available, the following functions can be used.
+
+@defun sqlite-open &optional file
+This function opens @var{file} as a database file. If it doesn't
+exist, a new database will be created and stored there. If this
+argument is missing or @code{nil}, a new in-memory database is created
+instead.
+
+The return value is a @dfn{database object} that can be used as the
+argument to most of the subsequent functions in this section of the
+manual.
+@end defun
+
+@defun sqlitep
+The database object returned by the @code{sqlite-open} function
+satisfies this predicate.
+@end defun
+
+@defun sqlite-close db
+Close the database @var{db}. It's usually not necessary to call this
+function explicitly---the database will automatically be closed if
+Emacs shuts down or the database object is garbage collected.
+@end defun
+
+@defun sqlite-execute db statement &optional values
+Execute the @acronym{SQL} @var{statement}. For instance:
+
+@lisp
+(sqlite-execute db "insert into foo values ('bar', 2)")
+@end lisp
+
+If the optional @var{values} parameter is present, it should be either
+a list or a vector of values to bind while executing the statement.
+For instance:
+
+@lisp
+(sqlite-execute db "insert into foo values (?, ?)" '("bar" 2))
+@end lisp
+
+This has exactly the same effect as the first form, but is more
+efficient and safer (because it doesn't involve any string parsing or
+interpolation).
+
+The number of affected rows is returned. For instance, an
+@samp{insert} statement will return @samp{1}, but an @samp{update}
+statement may return zero or a higher number.
+@end defun
+
+@defun sqlite-select db query &optional values result-type
+Select some data from @var{db} and return them. For instance:
+
+@lisp
+(sqlite-select db "select * from foo where key = 2")
+ @result{} (("bar" 2))
+@end lisp
+
+As with the @code{sqlite-execute} command, you can pass in a list or a
+vector of values that will be bound before executing the select:
+
+@lisp
+(sqlite-select db "select * from foo where key = ?" [2])
+ @result{} (("bar" 2))
+@end lisp
+
+This is usually more efficient and safer than the first method.
+
+This function, by default, returns a list of matching rows, where each
+row is a list of column values. If @var{return-type} is @code{full},
+the names of the columns (as a list of strings) will be returned as
+the first element in the return value.
+
+If @var{return-type} is @code{set}, this function will return a
+@dfn{statement object} instead. This object can be interrogated by
+the @code{sqlite-next}, @code{sqlite-columns} and @code{sqlite-more-p}
+functions. If the result set is small, it's often more convenient to
+just return the data directly, but if the result set is large (or if
+you won't be using all the data from the set), using the @code{set}
+method will allocate a lot less data, and therefore be more efficient.
+@end defun
+
+@defun sqlite-next statement
+This function returns the next row in the result set returned by
+@code{sqlite-select}.
+
+@lisp
+(sqlite-next stmt)
+ @result{} ("bar" 2)
+@end lisp
+@end defun
+
+@defun sqlite-columns statement
+This function returns the column names of the result set returned by
+@code{sqlite-select}.
+
+@lisp
+(sqlite-columns stmt)
+ @result{} ("name" "issue")
+@end lisp
+@end defun
+
+@defun sqlite-more-p statement
+This predicate says whether there is more data to be fetched in the
+result set returned by @code{sqlite-select}.
+@end defun
+
+@defun sqlite-finalize statement
+If @var{statement} is not going to be used any more, calling this
+function will free the resources bound by @var{statement}. This is
+usually not necessary---when the statement object is
+garbage-collected, this will happen automatically.
+@end defun
+
+@defun sqlite-transaction db
+Start a transaction in @var{db}. When in a transaction, other readers
+of the database won't access the results until the transaction has
+been committed.
+@end defun
+
+@defun sqlite-commit db
+End a transaction and write the data out to file.
+@end defun
+
+@defun sqlite-rollback db
+End a transaction and discard any changes that have been made.
+@end defun
+
+@defmac with-sqlite-transaction db &body body
+Like @code{progn}, but executes @var{body} with a transaction held,
+and do a commit at the end.
+@end defmac
+
+@defun sqlite-load-extension db module
+Load an extension into @var{db}. Extensions are usually @file{.so} files.
+@end defun
+
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
new file mode 100644
index 0000000..a47689c
--- /dev/null
+++ b/lisp/sqlite.el
@@ -0,0 +1,42 @@
+;;; sqlite.el --- Tests for empty.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defmacro with-sqlite-transaction (db &rest body)
+ "Execute BODY while holding a transaction for DB."
+ (declare (indent 1) (debug (form body)))
+ (let ((db-var (gensym)))
+ `(let ((,db-var ,db))
+ (if (sqlite-available-p)
+ (unwind-protect
+ (progn
+ (sqlite-transaction ,db-var)
+ ,@body)
+ (sqlite-commit ,db-var))
+ (progn
+ ,@body)))))
+
+(provide 'sqlite)
+
+;;; sqlite.el ends here
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 8b745c4..0ee010b 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -275,6 +275,7 @@ See the documentation of `create-fontset-from-fontset-spec'
for the format.")
'(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")))
'(svg "librsvg-2-2.dll")
'(webp "libwebp-7.dll" "libwebp.dll")
+ '(sqlite3 "libsqlite3-0.dll")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gio "libgio-2.0-0.dll")
diff --git a/src/Makefile.in b/src/Makefile.in
index d276df2..3a8445d 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -238,6 +238,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
LIBXML2_LIBS = @LIBXML2_LIBS@
LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
+SQLITE3_LIBS = @SQLITE3_LIBS@
+
GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
LCMS2_LIBS = @LCMS2_LIBS@
@@ -426,7 +428,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o
$(XMENU_OBJ) window.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \
- thread.o systhread.o \
+ thread.o systhread.o sqlite.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
@@ -549,7 +551,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS)
$(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \
+ $(SQLITE3_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index 55c3084..9f52a41 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -125,6 +125,7 @@ union emacs_align_type
struct Lisp_Overlay Lisp_Overlay;
struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table;
struct Lisp_Subr Lisp_Subr;
+ struct Lisp_Sqlite Lisp_Sqlite;
struct Lisp_User_Ptr Lisp_User_Ptr;
struct Lisp_Vector Lisp_Vector;
struct terminal terminal;
diff --git a/src/data.c b/src/data.c
index b2c3958..f07667b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -259,6 +259,8 @@ for example, (type-of 1) returns `integer'. */)
return Qxwidget;
case PVEC_XWIDGET_VIEW:
return Qxwidget_view;
+ case PVEC_SQLITE:
+ return Qsqlite;
/* "Impossible" cases. */
case PVEC_MISC_PTR:
case PVEC_OTHER:
diff --git a/src/emacs.c b/src/emacs.c
index 4734faf..3fc055a 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2183,6 +2183,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
#endif
syms_of_window ();
syms_of_xdisp ();
+ syms_of_sqlite ();
syms_of_font ();
#ifdef HAVE_WINDOW_SYSTEM
syms_of_fringe ();
diff --git a/src/lisp.h b/src/lisp.h
index d44ab55..92ab05b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1083,6 +1083,7 @@ enum pvec_type
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,
PVEC_NATIVE_COMP_UNIT,
+ PVEC_SQLITE,
/* These should be last, for internal_equal and sxhash_obj. */
PVEC_COMPILED,
@@ -2570,6 +2571,17 @@ xmint_pointer (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer;
}
+struct Lisp_Sqlite
+{
+ union vectorlike_header header;
+ void *db;
+ void *stmt;
+ char *name;
+ void (*finalizer) (void *);
+ bool eof;
+ bool is_statement;
+} GCALIGNED_STRUCT;
+
struct Lisp_User_Ptr
{
union vectorlike_header header;
@@ -2648,6 +2660,31 @@ XUSER_PTR (Lisp_Object a)
}
INLINE bool
+SQLITEP (Lisp_Object x)
+{
+ return PSEUDOVECTORP (x, PVEC_SQLITE);
+}
+
+INLINE bool
+SQLITE (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_SQLITE);
+}
+
+INLINE void
+CHECK_SQLITE (Lisp_Object x)
+{
+ CHECK_TYPE (SQLITE (x), Qsqlitep, x);
+}
+
+INLINE struct Lisp_Sqlite *
+XSQLITE (Lisp_Object a)
+{
+ eassert (SQLITEP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite);
+}
+
+INLINE bool
BIGNUMP (Lisp_Object x)
{
return PSEUDOVECTORP (x, PVEC_BIGNUM);
@@ -3793,6 +3830,9 @@ extern Lisp_Object safe_eval (Lisp_Object);
extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
+/* Defined in sqlite.c. */
+extern void syms_of_sqlite (void);
+
/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);
diff --git a/src/pdumper.c b/src/pdumper.c
index 7ff079d..c758bc8 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2948,7 +2948,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141
+#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -3028,6 +3028,8 @@ dump_vectorlike (struct dump_context *ctx,
error_unsupported_dump_object (ctx, lv, "mutex");
case PVEC_CONDVAR:
error_unsupported_dump_object (ctx, lv, "condvar");
+ case PVEC_SQLITE:
+ error_unsupported_dump_object (ctx, lv, "sqlite");
case PVEC_MODULE_FUNCTION:
error_unsupported_dump_object (ctx, lv, "module function");
default:
diff --git a/src/print.c b/src/print.c
index adadb28..214f1d1 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1875,6 +1875,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
break;
#endif
+ case PVEC_SQLITE:
+ {
+ print_c_string ("#<sqlite ", printcharfun);
+ int i = sprintf (buf, "db=%p", XSQLITE (obj)->db);
+ strout (buf, i, i, printcharfun);
+ if (XSQLITE (obj)->is_statement)
+ {
+ i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt);
+ strout (buf, i, i, printcharfun);
+ }
+ i = sprintf (buf, " name=%s", XSQLITE (obj)->name);
+ strout (buf, i, i, printcharfun);
+ printchar ('>', printcharfun);
+ }
+ break;
+
default:
emacs_abort ();
}
diff --git a/src/sqlite.c b/src/sqlite.c
new file mode 100644
index 0000000..b1843bc
--- /dev/null
+++ b/src/sqlite.c
@@ -0,0 +1,708 @@
+/*
+Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+This file is based on the emacs-sqlite3 package written by Syohei
+YOSHIDA <syohex@gmail.com>, which can be found at:
+
+ https://github.com/syohex/emacs-sqlite3
+*/
+
+#include <config.h>
+#include "lisp.h"
+#include "coding.h"
+
+#ifdef HAVE_SQLITE3
+
+#include <sqlite3.h>
+
+#ifdef WINDOWSNT
+
+# include <windows.h>
+# include "w32common.h"
+# include "w32.h"
+
+DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
+ (const char*, sqlite3**, int, const char*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text,
+ (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
+ (sqlite3_stmt*, int, sqlite3_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 const char*, sqlite3_errmsg, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
+ (sqlite3*, const char*, int (*callback)(void*,int,char**,char**),
+ void*, char**));
+DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
+ (sqlite3*, const char*, const char*, char**));
+DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
+ (sqlite3*, const char*, int, sqlite3_stmt**, const char**));
+
+# undef sqlite3_finalize
+# undef sqlite3_close
+# undef sqlite3_open_v2
+# undef sqlite3_reset
+# undef sqlite3_bind_text
+# undef sqlite3_bind_int64
+# undef sqlite3_bind_double
+# undef sqlite3_bind_null
+# undef sqlite3_bind_int
+# undef sqlite3_errmsg
+# undef sqlite3_step
+# undef sqlite3_changes
+# undef sqlite3_column_count
+# undef sqlite3_column_type
+# undef sqlite3_column_int64
+# undef sqlite3_column_double
+# undef sqlite3_column_blob
+# undef sqlite3_column_bytes
+# undef sqlite3_column_text
+# undef sqlite3_column_name
+# undef sqlite3_exec
+# undef sqlite3_load_extension
+# undef sqlite3_prepare_v2
+
+# define sqlite3_finalize fn_sqlite3_finalize
+# define sqlite3_close fn_sqlite3_close
+# define sqlite3_open_v2 fn_sqlite3_open_v2
+# define sqlite3_reset fn_sqlite3_reset
+# define sqlite3_bind_text fn_sqlite3_bind_text
+# define sqlite3_bind_int64 fn_sqlite3_bind_int64
+# 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_errmsg fn_sqlite3_errmsg
+# define sqlite3_step fn_sqlite3_step
+# define sqlite3_changes fn_sqlite3_changes
+# define sqlite3_column_count fn_sqlite3_column_count
+# define sqlite3_column_type fn_sqlite3_column_type
+# define sqlite3_column_int64 fn_sqlite3_column_int64
+# define sqlite3_column_double fn_sqlite3_column_double
+# define sqlite3_column_blob fn_sqlite3_column_blob
+# define sqlite3_column_bytes fn_sqlite3_column_bytes
+# define sqlite3_column_text fn_sqlite3_column_text
+# define sqlite3_column_name fn_sqlite3_column_name
+# define sqlite3_exec fn_sqlite3_exec
+# define sqlite3_load_extension fn_sqlite3_load_extension
+# define sqlite3_prepare_v2 fn_sqlite3_prepare_v2
+
+static bool
+load_dll_functions (HMODULE library)
+{
+ LOAD_DLL_FN (library, sqlite3_finalize);
+ LOAD_DLL_FN (library, sqlite3_close);
+ LOAD_DLL_FN (library, sqlite3_open_v2);
+ LOAD_DLL_FN (library, sqlite3_reset);
+ LOAD_DLL_FN (library, sqlite3_bind_text);
+ LOAD_DLL_FN (library, sqlite3_bind_int64);
+ 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_errmsg);
+ LOAD_DLL_FN (library, sqlite3_step);
+ LOAD_DLL_FN (library, sqlite3_changes);
+ LOAD_DLL_FN (library, sqlite3_column_count);
+ LOAD_DLL_FN (library, sqlite3_column_type);
+ LOAD_DLL_FN (library, sqlite3_column_int64);
+ LOAD_DLL_FN (library, sqlite3_column_double);
+ LOAD_DLL_FN (library, sqlite3_column_blob);
+ LOAD_DLL_FN (library, sqlite3_column_bytes);
+ LOAD_DLL_FN (library, sqlite3_column_text);
+ LOAD_DLL_FN (library, sqlite3_column_name);
+ LOAD_DLL_FN (library, sqlite3_exec);
+ LOAD_DLL_FN (library, sqlite3_load_extension);
+ LOAD_DLL_FN (library, sqlite3_prepare_v2);
+ return true;
+}
+
+static bool
+sqlite_loaded_p (void)
+{
+ Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
+
+ return CONSP (found) && EQ (XCDR (found), Qt);
+}
+#endif /* WINDOWSNT */
+
+static bool
+init_sqlite_functions (void)
+{
+#ifdef WINDOWSNT
+ if (sqlite_loaded_p ())
+ return true;
+ else
+ {
+ HMODULE library;
+
+ if (!(library = w32_delayed_load (Qsqlite3)))
+ {
+ message1 ("sqlite3 library not found");
+ return false;
+ }
+
+ if (! load_dll_functions (library))
+ goto bad_library;
+
+ Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache);
+ return true;
+ }
+
+ bad_library:
+ Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache);
+
+ return false;
+#else /* !WINDOWSNT */
+ return true;
+#endif /* !WINDOWSNT */
+}
+
+
+static void
+sqlite_free (void *arg)
+{
+ struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg;
+ if (ptr->is_statement)
+ sqlite3_finalize (ptr->stmt);
+ else if (ptr->db)
+ sqlite3_close (ptr->db);
+ xfree (ptr->name);
+ xfree (ptr);
+}
+
+static Lisp_Object
+encode_string (Lisp_Object string)
+{
+ if (STRING_MULTIBYTE (string))
+ return encode_string_utf_8 (string, Qnil, 0, Qt, Qt);
+ else
+ return string;
+}
+
+static Lisp_Object
+make_sqlite (bool is_statement, void *db, void *stmt, char *name)
+{
+ struct Lisp_Sqlite *ptr
+ = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE);
+ ptr->is_statement = is_statement;
+ ptr->finalizer = sqlite_free;
+ ptr->db = db;
+ ptr->name = name;
+ ptr->stmt = stmt;
+ ptr->eof = false;
+ return make_lisp_ptr (ptr, Lisp_Vectorlike);
+}
+
+static void
+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"));
+ else if (!is_statement && XSQLITE (db)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid database object"));
+ if (!is_statement && !XSQLITE (db)->db)
+ xsignal1 (Qerror, build_string ("Database closed"));
+ else if (is_statement && !XSQLITE (db)->db)
+ xsignal1 (Qerror, build_string ("Statement closed"));
+}
+
+static int db_count = 0;
+
+DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0,
+ doc: /* Open FILE as an sqlite database.
+If FILE is nil, an in-memory database will be opened instead. */)
+ (Lisp_Object file)
+{
+ char *name;
+ init_sqlite_functions ();
+
+ if (!NILP (file))
+ {
+ CHECK_STRING (file);
+ name = xstrdup (SSDATA (Fexpand_file_name (file, Qnil)));
+ }
+ else
+ /* In-memory database. These have to have different names to
+ refer to different databases. */
+ name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"),
+ make_int (++db_count))));
+
+ sqlite3 *sdb;
+ int ret = sqlite3_open_v2 (name,
+ &sdb,
+ SQLITE_OPEN_FULLMUTEX
+ | SQLITE_OPEN_READWRITE
+ | SQLITE_OPEN_CREATE
+ | (NILP (file) ? SQLITE_OPEN_MEMORY : 0)
+#ifdef SQLITE_OPEN_URI
+ | SQLITE_OPEN_URI
+#endif
+ | 0, NULL);
+
+ if (ret != SQLITE_OK)
+ return Qnil;
+
+ return make_sqlite (false, sdb, NULL, name);
+}
+
+DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
+ doc: /* Close the database DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ sqlite3_close (XSQLITE (db)->db);
+ XSQLITE (db)->db = NULL;
+ return Qnil;
+}
+
+/* Bind values in a statement like
+ "insert into foo values (?, ?, ?)". */
+static const char *
+bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
+{
+ sqlite3_reset (stmt);
+ int len;
+ if (VECTORP (values))
+ len = ASIZE (values);
+ else
+ len = list_length (values);
+
+ for (int i = 0; i < len; ++i)
+ {
+ int ret = SQLITE_MISMATCH;
+ Lisp_Object value;
+ if (VECTORP (values))
+ value = AREF (values, i);
+ else
+ {
+ value = XCAR (values);
+ values = XCDR (values);
+ }
+ Lisp_Object type = Ftype_of (value);
+
+ if (EQ (type, Qstring))
+ {
+ Lisp_Object encoded = encode_string (value);
+ ret = sqlite3_bind_text (stmt, i + 1,
+ SSDATA (encoded), SBYTES (encoded),
+ NULL);
+ }
+ else if (EQ (type, Qinteger))
+ {
+ if (BIGNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
+ else
+ ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
+ }
+ else if (EQ (type, Qfloat))
+ ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
+ else if (NILP (value))
+ ret = sqlite3_bind_null (stmt, i + 1);
+ else if (EQ (value, Qt))
+ ret = sqlite3_bind_int (stmt, i + 1, 1);
+ else if (EQ (value, Qfalse))
+ ret = sqlite3_bind_int (stmt, i + 1, 0);
+ else
+ return "invalid argument";
+
+ if (ret != SQLITE_OK)
+ return sqlite3_errmsg (db);
+ }
+
+ return NULL;
+}
+
+DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
+ doc: /* Execute a non-select SQL statement.
+If VALUES is non-nil, it should be a list of values to bind when
+executing a statement like
+
+ insert into foo values (?, ?, ...)
+
+The number of affected rows is returned. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values)
+{
+ 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"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+ Lisp_Object encoded = encode_string (query);
+ sqlite3_stmt *stmt = NULL;
+
+ /* We only execute the first statement -- if there's several
+ (separated by a semicolon), the subsequent statements won't be
+ done. */
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt != NULL)
+ {
+ sqlite3_finalize (stmt);
+ sqlite3_reset (stmt);
+ }
+
+ errmsg = sqlite3_errmsg (sdb);
+ goto exit;
+ }
+
+ /* Bind ? values. */
+ if (!NILP (values)) {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ ret = sqlite3_step (stmt);
+ sqlite3_finalize (stmt);
+ if (ret != SQLITE_OK && ret != SQLITE_DONE)
+ {
+ errmsg = sqlite3_errmsg (sdb);
+ goto exit;
+ }
+
+ retval = make_fixnum (sqlite3_changes (sdb));
+
+ exit:
+ if (errmsg != NULL)
+ xsignal1 (Qerror, build_string (errmsg));
+
+ return retval;
+}
+
+static Lisp_Object
+row_to_value (sqlite3_stmt *stmt)
+{
+ int len = sqlite3_column_count (stmt);
+ Lisp_Object values = Qnil;
+
+ for (int i = 0; i < len; ++i)
+ {
+ Lisp_Object v = Qnil;
+
+ switch (sqlite3_column_type (stmt, i))
+ {
+ case SQLITE_INTEGER:
+ v = make_int (sqlite3_column_int64 (stmt, i));
+ break;
+
+ case SQLITE_FLOAT:
+ v = make_float (sqlite3_column_double (stmt, i));
+ break;
+
+ case SQLITE_BLOB:
+ v =
+ code_convert_string_norecord
+ (make_string (sqlite3_column_blob (stmt, i),
+ sqlite3_column_bytes (stmt, i)),
+ Qutf_8, false);
+ break;
+
+ case SQLITE_NULL:
+ v = Qnil;
+ break;
+
+ case SQLITE_TEXT:
+ v =
+ code_convert_string_norecord
+ (make_string ((const char*)sqlite3_column_text (stmt, i),
+ sqlite3_column_bytes (stmt, i)),
+ Qutf_8, false);
+ break;
+ }
+
+ values = Fcons (v, values);
+ }
+
+ return Fnreverse (values);
+}
+
+static Lisp_Object
+column_names (sqlite3_stmt *stmt)
+{
+ Lisp_Object columns = Qnil;
+ int count = sqlite3_column_count (stmt);
+ for (int i = 0; i < count; ++i)
+ columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns);
+
+ return Fnreverse (columns);
+}
+
+DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0,
+ doc: /* Select data from the database DB that matches QUERY.
+If VALUES is non-nil, they are values that will be interpolated into a
+parametrised 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.
+
+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. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values,
+ Lisp_Object return_type)
+{
+ 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"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+ Lisp_Object encoded = encode_string (query);
+
+ sqlite3_stmt *stmt = NULL;
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
+ &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt)
+ sqlite3_finalize (stmt);
+
+ goto exit;
+ }
+
+ /* Query with parameters. */
+ if (!NILP (values))
+ {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ sqlite3_finalize (stmt);
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ /* Return a handle to get the data. */
+ if (EQ (return_type, Qset))
+ {
+ retval = make_sqlite (true, db, stmt, XSQLITE (db)->name);
+ goto exit;
+ }
+
+ /* Return the data directly. */
+ Lisp_Object data = Qnil;
+ while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
+ data = Fcons (row_to_value (stmt), data);
+
+ if (EQ (return_type, Qfull))
+ retval = Fcons (column_names (stmt), Fnreverse (data));
+ else
+ retval = Fnreverse (data);
+ sqlite3_finalize (stmt);
+
+ exit:
+ if (errmsg != NULL)
+ xsignal1 (Qerror, build_string (errmsg));
+
+ return retval;
+}
+
+static Lisp_Object
+sqlite_exec (sqlite3 *sdb, const char *query)
+{
+ int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL);
+ if (ret != SQLITE_OK)
+ return Qnil;
+
+ return Qt;
+}
+
+DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0,
+ doc: /* Start a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "begin");
+}
+
+DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0,
+ doc: /* Commit a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "commit");
+}
+
+DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0,
+ doc: /* Roll back a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "rollback");
+}
+
+DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
+ Ssqlite_load_extension, 2, 2, 0,
+ doc: /* Load a an SQlite module into DB.
+MODULE should be the file name of an SQlite module .so file. */)
+ (Lisp_Object db, Lisp_Object module)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (module);
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ int result = sqlite3_load_extension (sdb,
+ SSDATA (Fexpand_file_name (module,
Qnil)),
+ NULL, NULL);
+ if (result == SQLITE_OK)
+ return Qt;
+ return Qnil;
+}
+
+DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
+ doc: /* Return the next result set from SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+
+ 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)));
+
+ if (ret == SQLITE_DONE)
+ {
+ XSQLITE (set)->eof = true;
+ return Qnil;
+ }
+
+ return row_to_value (XSQLITE (set)->stmt);
+}
+
+DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0,
+ doc: /* Return the column names of SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+ return column_names (XSQLITE (set)->stmt);
+}
+
+DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0,
+ doc: /* Say whether there's any further results in SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+
+ if (XSQLITE (set)->eof)
+ return Qnil;
+ else
+ return Qt;
+}
+
+DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0,
+ doc: /* Mark this SET as being finished.
+This will free the resources held by SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+ sqlite3_finalize (XSQLITE (set)->stmt);
+ return Qt;
+}
+
+#endif /* HAVE_SQLITE3 */
+
+DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0,
+ doc: /* Say whether OBJECT is an SQlite object. */)
+ (Lisp_Object object)
+{
+#ifdef HAVE_SQLITE3
+ return SQLITE (object)? Qt: Qnil;
+#else
+ return Qnil;
+#endif
+}
+
+DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0,
+ doc: /* Return t if sqlite3 support is available in this instance of
Emacs.*/)
+ (void)
+{
+#ifdef HAVE_SQLITE3
+# ifdef WINDOWSNT
+ Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
+ if (CONSP (found))
+ return XCDR (found);
+ else
+ {
+ Lisp_Object status;
+ status = init_sqlite_functions () ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qsqlite3, status), Vlibrary_cache);
+ return status;
+ }
+# else
+ return Qt;
+#endif
+#else
+ return Qnil;
+#endif
+}
+
+void
+syms_of_sqlite (void)
+{
+#ifdef HAVE_SQLITE3
+ defsubr (&Ssqlite_open);
+ defsubr (&Ssqlite_close);
+ defsubr (&Ssqlite_execute);
+ defsubr (&Ssqlite_select);
+ defsubr (&Ssqlite_transaction);
+ defsubr (&Ssqlite_commit);
+ defsubr (&Ssqlite_rollback);
+ defsubr (&Ssqlite_load_extension);
+ defsubr (&Ssqlite_next);
+ defsubr (&Ssqlite_columns);
+ defsubr (&Ssqlite_more_p);
+ defsubr (&Ssqlite_finalize);
+ DEFSYM (Qset, "set");
+ DEFSYM (Qfull, "full");
+#endif
+ defsubr (&Ssqlitep);
+ DEFSYM (Qsqlitep, "sqlitep");
+ defsubr (&Ssqlite_available_p);
+ DEFSYM (Qfalse, "false");
+ DEFSYM (Qsqlite, "sqlite");
+ DEFSYM (Qsqlite3, "sqlite3");
+}
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
new file mode 100644
index 0000000..3fffa01
--- /dev/null
+++ b/test/src/sqlite-tests.el
@@ -0,0 +1,175 @@
+;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+
+(ert-deftest sqlite-select ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (should (eq (type-of db) 'sqlite))
+ (should (sqlitep db))
+ (should-not (sqlitep 'foo))
+
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer, col3
float, col4 blob)")))
+
+ (should-error
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45,
'bar', 'zot')"))
+
+ (should
+ (=
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45,
'bar')")
+ 1))
+
+ (should
+ (equal
+ (sqlite-select db "select * from test1" nil 'full)
+ '(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar"))))))
+
+;; (setq db (sqlite-open))
+
+(ert-deftest sqlite-set ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open))
+ set)
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer)")))
+
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('foo', 1)")
+ 1))
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('bar', 2)")
+ 1))
+
+ (setq set (sqlite-select db "select * from test1" nil 'set))
+ (should (sqlitep set))
+ (should (sqlite-more-p set))
+ (should (equal (sqlite-next set)
+ '("foo" 1)))
+ (should (equal (sqlite-next set)
+ '("bar" 2)))
+ (should-not (sqlite-next set))
+ (should-not (sqlite-more-p set))))
+
+(ert-deftest sqlite-chars ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test2 (col1 text, col2 integer)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fóo', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fóo', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fo', 4)")
+ (should
+ (equal (sqlite-select db "select * from test2" nil 'full)
+ '(("col1" "col2") ("fóo" 3) ("fóo" 3) ("fo" 4))))))
+
+(ert-deftest sqlite-numbers ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test3 (col1 integer)")
+ (let ((big (expt 2 50))
+ (small (expt 2 10)))
+ (sqlite-execute db (format "insert into test3 values (%d)" small))
+ (sqlite-execute db (format "insert into test3 values (%d)" big))
+ (should
+ (equal
+ (sqlite-select db "select * from test3")
+ (list (list small) (list big)))))))
+
+(ert-deftest sqlite-param ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test4 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test4 values (?, ?)" (list "foo" 1))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" '(1))
+ '(("foo" 1))))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" [1])
+ '(("foo" 1))))))
+
+(ert-deftest sqlite-binary ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test5 (col1 text, col2 number)")
+ (let ((string (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert 0 1 2)
+ (buffer-string))))
+ (should-not (multibyte-string-p string))
+ (sqlite-execute
+ db "insert into test5 values (?, ?)" (list string 2))
+ (let ((out (caar
+ (sqlite-select db "select col1 from test5 where col2 = 2"))))
+ (should (equal out string))))))
+
+(ert-deftest sqlite-different-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db1 db2)
+ (setq db1 (sqlite-open))
+ (setq db2 (sqlite-open))
+ (sqlite-execute
+ db1 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db2 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db1 "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db1 "select * from test6"))
+ (should-not (sqlite-select db2 "select * from test6"))))
+
+(ert-deftest sqlite-close-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db "select * from test6"))
+ (sqlite-close db)
+ (should-error (sqlite-select db "select * from test6"))))
+
+;;; sqlite-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3d38d1d: Add sqlite3 support to Emacs,
Lars Ingebrigtsen <=