[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/sqlite bf1bfe3: Add initial implementation of sqlite3 support
|
From: |
Lars Ingebrigtsen |
|
Subject: |
scratch/sqlite bf1bfe3: Add initial implementation of sqlite3 support |
|
Date: |
Mon, 6 Dec 2021 13:55:50 -0500 (EST) |
branch: scratch/sqlite
commit bf1bfe3f59d3bc44a2e34218f92980aa38351502
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add initial implementation of sqlite3 support
---
admin/CPP-DEFINES | 1 +
configure.ac | 16 +-
src/Makefile.in | 7 +-
src/alloc.c | 1 +
src/data.c | 2 +
src/emacs.c | 1 +
src/lisp.h | 40 +++++
src/pdumper.c | 2 +
src/print.c | 9 +
src/sqlite.c | 448 +++++++++++++++++++++++++++++++++++++++++++++++
test/src/sqlite-tests.el | 105 +++++++++++
11 files changed, 629 insertions(+), 3 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..e81b380 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,18 @@ 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_finalize, 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).])
+ 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 +6168,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 +6215,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/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..9ba8c12 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;
+ Lisp_Object fields;
+ void *db;
+ void *stmt;
+ 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..e19505b 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -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..b32580c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1875,6 +1875,15 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
break;
#endif
+ case PVEC_SQLITE:
+ {
+ print_c_string ("#<sqlite ", printcharfun);
+ int i = sprintf (buf, "ptr=%p", XSQLITE (obj)->db);
+ 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..53fadb8
--- /dev/null
+++ b/src/sqlite.c
@@ -0,0 +1,448 @@
+/*
+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 <sqlite3.h>
+
+#ifdef HAVE_SQLITE3
+
+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);
+}
+
+static Lisp_Object
+make_sqlite (bool is_statement, void *db, void *stmt, Lisp_Object fields)
+{
+ struct Lisp_Sqlite *ptr
+ = ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Sqlite, fields, PVEC_SQLITE);
+ ptr->fields = Qnil;
+ ptr->is_statement = is_statement;
+ ptr->finalizer = sqlite_free;
+ ptr->db = db;
+ ptr->stmt = stmt;
+ ptr->fields = fields;
+ ptr->eof = false;
+ return make_lisp_ptr (ptr, Lisp_Vectorlike);
+}
+
+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)
+{
+ if (!NILP (file))
+ {
+ CHECK_STRING (file);
+ file = Fexpand_file_name (file, Qnil);
+ }
+
+ sqlite3 *sdb;
+ int ret = sqlite3_open_v2 (NILP (file) ? ":memory:" : SSDATA (file),
+ &sdb,
+ SQLITE_OPEN_FULLMUTEX
+ | SQLITE_OPEN_READWRITE
+ | SQLITE_OPEN_CREATE
+#ifdef SQLITE_OPEN_URI
+ | SQLITE_OPEN_URI
+#endif
+ | 0, NULL);
+ if (ret != SQLITE_OK)
+ return Qnil;
+
+ return make_sqlite (false, sdb, NULL, 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 = ASIZE (values);
+
+ for (int i = 0; i < len; ++i)
+ {
+ int ret = SQLITE_MISMATCH;
+ Lisp_Object value = AREF (values, i);
+ Lisp_Object type = Ftype_of (value);
+
+ if (EQ (type, Qstring))
+ ret = sqlite3_bind_text (stmt, i + 1,
+ SSDATA (value), SBYTES (value),
+ NULL);
+ else if (EQ (type, Qinteger))
+ 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 (?, ?, ...)
+
+QUERY can include several statements, separated by a semicolon.
+
+The number of affected rows is returned. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values)
+{
+ CHECK_SQLITE (db);
+ CHECK_STRING (query);
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ char *sql, *tail;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+
+ char *top = xmalloc (SBYTES (query) + 1);
+ if (top == NULL)
+ return Qnil;
+
+ memcpy (top, SSDATA (query), SBYTES (query) + 1);
+ tail = top;
+
+ while (*(sql = tail) != '\0')
+ {
+ sqlite3_stmt *stmt = NULL;
+ int ret = sqlite3_prepare_v2 (sdb, sql, -1, &stmt, (const char**)&tail);
+ /* FIXME: Same values for each statement? */
+ if (!NILP (values)) {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ if (ret != SQLITE_OK)
+ {
+ if (stmt != NULL)
+ {
+ sqlite3_finalize (stmt);
+ sqlite3_reset (stmt);
+ }
+
+ errmsg = sqlite3_errmsg (sdb);
+ goto exit;
+ }
+
+ if (stmt == NULL)
+ continue;
+
+ 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:
+ xfree (top);
+
+ 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_fixnum (sqlite3_column_int64 (stmt, i));
+ break;
+
+ case SQLITE_FLOAT:
+ v = make_float (sqlite3_column_double (stmt, i));
+ break;
+
+ case SQLITE_BLOB:
+ v = make_string (sqlite3_column_blob (stmt, i),
+ sqlite3_column_bytes (stmt, i));
+ break;
+
+ case SQLITE_NULL:
+ v = Qnil;
+ break;
+
+ /* The data in sqlite3 is utf-8, so we apparently don't have
+ to do any de/encoding. */
+ case SQLITE_TEXT:
+ v = make_string ((const char*)sqlite3_column_text (stmt, i),
+ sqlite3_column_bytes (stmt, i));
+ break;
+ }
+
+ values = Fcons (v, values);
+ }
+
+ return Freverse (values);
+}
+
+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.
+If CURSOR is non-nil, an opaque object is returned instead 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 cursor)
+{
+ CHECK_SQLITE (db);
+ CHECK_STRING (query);
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+
+ sqlite3_stmt *stmt = NULL;
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (query), SBYTES (query),
+ &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt)
+ sqlite3_finalize (stmt);
+
+ goto exit;
+ }
+
+ if (!NILP (values))
+ {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ sqlite3_finalize (stmt);
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ /* Get the field names. */
+ Lisp_Object fields = Qnil;
+ int count = sqlite3_column_count (stmt);
+ for (int i = 0; i < count; ++i)
+ fields = Fcons (build_string (sqlite3_column_name (stmt, i)), fields);
+
+ fields = Fnreverse (fields);
+
+ if (!NILP (cursor))
+ {
+ retval = make_sqlite (true, db, stmt, fields);
+ goto exit;
+ }
+
+ /* Return the data directly. */
+ Lisp_Object data = Qnil;
+ while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
+ data = Fcons (row_to_value (stmt), data);
+
+ retval = Fcons (fields, 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);
+ 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);
+ 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);
+ 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);
+ CHECK_STRING (module);
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ int result = sqlite3_load_extension (sdb, SSDATA (module), 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);
+ if (!XSQLITE (set)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid set object"));
+
+ 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);
+ if (!XSQLITE (set)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid set object"));
+
+ return XSQLITE (set)->fields;
+}
+
+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);
+ if (!XSQLITE (set)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid set object"));
+
+ if (XSQLITE (set)->eof)
+ return Qnil;
+ else
+ return Qt;
+}
+
+DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0,
+ doc: /* Say whether OBJECT is an SQlite object. */)
+ (Lisp_Object object)
+{
+ return SQLITE (object)? Qt: Qnil;
+}
+
+#endif /* HAVE_SQLITE3 */
+
+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
+ return Qt;
+#else
+ return Qnil;
+#endif
+}
+
+
+void
+syms_of_sqlite (void)
+{
+#ifdef HAVE_SQLITE3
+ defsubr (&Ssqlite_open);
+ 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 (&Ssqlitep);
+ DEFSYM (Qsqlitep, "sqlitep");
+#endif
+ defsubr (&Ssqlite_available_p);
+ DEFSYM (Qfalse, "false");
+ DEFSYM (Qsqlite, "sqlite");
+}
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
new file mode 100644
index 0000000..96e72df
--- /dev/null
+++ b/test/src/sqlite-tests.el
@@ -0,0 +1,105 @@
+;;; 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")
+ '(("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 t))
+ (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 (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 ('fo', 4)")
+ (should
+ (equal (sqlite-select db "select * from test2")
+ '(("col1" "col2") ("fóo" 3) ("fo" 4))))))
+
+;;; sqlite-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/sqlite bf1bfe3: Add initial implementation of sqlite3 support,
Lars Ingebrigtsen <=