Skip to content

Commit f65e8eb

Browse files
interkosmosinterkosmos
committed
Added interfaces to sqlite3_config().
1 parent ce0946d commit f65e8eb

File tree

2 files changed

+161
-1
lines changed

2 files changed

+161
-1
lines changed

‎src/sqlite.f90‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,36 @@ module sqlite
108108
integer, parameter, public :: SQLITE_DBSTATUS_CACHE_SPILL = 12
109109
integer, parameter, public :: SQLITE_DBSTATUS_MAX = 12 ! Largest defined DBSTATUS.
110110

111+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SINGLETHREAD = 1 ! nil
112+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MULTITHREAD = 2 ! nil
113+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SERIALIZED = 3 ! nil
114+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MALLOC = 4 ! sqlite3_mem_methods*
115+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETMALLOC = 5 ! sqlite3_mem_methods*
116+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SCRATCH = 6 ! No longer used
117+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PAGECACHE = 7 ! void*, int sz, int N
118+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_HEAP = 8 ! void*, int nByte, int min
119+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MEMSTATUS = 9 ! boolean
120+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MUTEX = 10 ! sqlite3_mutex_methods*
121+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETMUTEX = 11 ! sqlite3_mutex_methods*
122+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_CHUNKALLOC = 12 ! unused
123+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_LOOKASIDE = 13 ! int int
124+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE = 14 ! no-op
125+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETPCACHE = 15 ! no-op
126+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_LOG = 16 ! xFunc, void*
127+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_URI = 17 ! int
128+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE2 = 18 ! sqlite3_pcache_methods2*
129+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETPCACHE2 = 19 ! sqlite3_pcache_methods2*
130+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_COVERING_INDEX_SCAN = 20 ! int
131+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SQLLOG = 21 ! xSqllog, void*
132+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MMAP_SIZE = 22 ! sqlite3_int64, sqlite3_int64
133+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_WIN32_HEAPSIZE = 23 ! int nByte
134+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE_HDRSZ = 24 ! int *psz
135+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PMASZ = 25 ! unsigned int szPma
136+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_STMTJRNL_SPILL = 26 ! int nByte
137+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SMALL_MALLOC = 27 ! boolean
138+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SORTERREF_SIZE = 28 ! int nByte
139+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MEMDB_MAXSIZE = 29 ! sqlite3_int64
140+
111141
integer(kind=c_size_t), parameter, public :: SQLITE_STATIC = 0
112142
integer(kind=c_size_t), parameter, public :: SQLITE_TRANSIENT = -1
113143

@@ -123,6 +153,10 @@ module sqlite
123153
public :: sqlite3_column_int64
124154
public :: sqlite3_column_text
125155
public :: sqlite3_column_type
156+
public :: sqlite3_config
157+
public :: sqlite3_config_funptr_ptr_
158+
public :: sqlite3_config_int_
159+
public :: sqlite3_config_null_
126160
public :: sqlite3_data_count
127161
public :: sqlite3_db_status
128162
public :: sqlite3_errcode
@@ -132,6 +166,7 @@ module sqlite
132166
public :: sqlite3_exec_
133167
public :: sqlite3_finalize
134168
public :: sqlite3_free
169+
public :: sqlite3_initialize
135170
public :: sqlite3_last_insert_rowid
136171
public :: sqlite3_libversion
137172
public :: sqlite3_libversion_
@@ -143,6 +178,7 @@ module sqlite
143178
public :: sqlite3_prepare_v2
144179
public :: sqlite3_prepare_v2_
145180
public :: sqlite3_reset
181+
public :: sqlite3_shutdown
146182
public :: sqlite3_sleep
147183
public :: sqlite3_sourceid
148184
public :: sqlite3_sourceid_
@@ -267,6 +303,33 @@ function sqlite3_column_type(stmt, icol) bind(c, name='sqlite3_column_type')
267303
integer(kind=c_int) :: sqlite3_column_type
268304
end function sqlite3_column_type
269305

306+
! int sqlite3_config(int option, ...)
307+
function sqlite3_config_funptr_ptr_(option, funptr, ptr) bind(c, name='sqlite3_config')
308+
import :: c_funptr, c_int, c_ptr
309+
implicit none
310+
integer(kind=c_int), intent(in), value :: option
311+
type(c_funptr), intent(in), value :: funptr
312+
type(c_ptr), intent(in), value :: ptr
313+
integer(kind=c_int) :: sqlite3_config_funptr_ptr_
314+
end function sqlite3_config_funptr_ptr_
315+
316+
! int sqlite3_config(int option, ...)
317+
function sqlite3_config_int_(option, arg) bind(c, name='sqlite3_config')
318+
import :: c_int
319+
implicit none
320+
integer(kind=c_int), intent(in), value :: option
321+
integer(kind=c_int), intent(in), value :: arg
322+
integer(kind=c_int) :: sqlite3_config_int_
323+
end function sqlite3_config_int_
324+
325+
! int sqlite3_config(int option, ...)
326+
function sqlite3_config_null_(option) bind(c, name='sqlite3_config')
327+
import :: c_int
328+
implicit none
329+
integer(kind=c_int), intent(in), value :: option
330+
integer(kind=c_int) :: sqlite3_config_null_
331+
end function sqlite3_config_null_
332+
270333
! int sqlite3_data_count(sqlite3_stmt *stmt)
271334
function sqlite3_data_count(stmt) bind(c, name='sqlite3_data_count')
272335
import :: c_int, c_ptr
@@ -323,6 +386,13 @@ function sqlite3_finalize(stmt) bind(c, name='sqlite3_finalize')
323386
integer(kind=c_int) :: sqlite3_finalize
324387
end function sqlite3_finalize
325388

389+
! int sqlite3_initialize(void)
390+
function sqlite3_initialize() bind(c, name='sqlite3_initialize')
391+
import :: c_int
392+
implicit none
393+
integer(kind=c_int) :: sqlite3_initialize
394+
end function sqlite3_initialize
395+
326396
! sqlite3_int64 sqlite3_last_insert_rowid(sqlite3 *db)
327397
function sqlite3_last_insert_rowid(db) bind(c, name='sqlite3_last_insert_rowid')
328398
import :: c_int64_t, c_ptr
@@ -386,6 +456,13 @@ function sqlite3_reset(stmt) bind(c, name='sqlite3_reset')
386456
integer(kind=c_int) :: sqlite3_reset
387457
end function sqlite3_reset
388458

459+
! int sqlite3_shutdown(void)
460+
function sqlite3_shutdown() bind(c, name='sqlite3_shutdown')
461+
import :: c_int
462+
implicit none
463+
integer(kind=c_int) :: sqlite3_shutdown
464+
end function sqlite3_shutdown
465+
389466
! int sqlite3_sleep(int t)
390467
function sqlite3_sleep(t) bind(c, name='sqlite3_sleep')
391468
import :: c_int
@@ -531,6 +608,12 @@ function c_strlen(str) bind(c, name='strlen')
531608
integer(c_size_t) :: c_strlen
532609
end function c_strlen
533610
end interface
611+
612+
interface sqlite3_config
613+
module procedure :: sqlite3_config_funptr_ptr
614+
module procedure :: sqlite3_config_int
615+
module procedure :: sqlite3_config_null
616+
end interface
534617
contains
535618
pure function copy(a)
536619
character, intent(in) :: a(:)
@@ -584,6 +667,30 @@ function sqlite3_column_text(stmt, icol)
584667
call c_f_str_ptr(ptr, sqlite3_column_text)
585668
end function sqlite3_column_text
586669

670+
function sqlite3_config_int(option, arg)
671+
integer, intent(in) :: option
672+
integer, intent(in) :: arg
673+
integer :: sqlite3_config_int
674+
675+
sqlite3_config_int = sqlite3_config_int_(option, arg)
676+
end function sqlite3_config_int
677+
678+
function sqlite3_config_funptr_ptr(option, funptr, ptr)
679+
integer, intent(in) :: option
680+
type(c_funptr), intent(in) :: funptr
681+
type(c_ptr), intent(in) :: ptr
682+
integer :: sqlite3_config_funptr_ptr
683+
684+
sqlite3_config_funptr_ptr = sqlite3_config_funptr_ptr_(option, funptr, ptr)
685+
end function sqlite3_config_funptr_ptr
686+
687+
function sqlite3_config_null(option)
688+
integer, intent(in) :: option
689+
integer :: sqlite3_config_null
690+
691+
sqlite3_config_null = sqlite3_config_null_(option)
692+
end function sqlite3_config_null
693+
587694
function sqlite3_errmsg(db)
588695
type(c_ptr), intent(in) :: db
589696
character(len=:), allocatable :: sqlite3_errmsg

‎test/test_sqlite.f90‎

Lines changed: 54 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module callbacks
55
implicit none
66
private
77

8+
public :: error_log_callback
89
public :: exec_callback
910
public :: update_callback
1011
contains
@@ -34,6 +35,20 @@ integer(kind=c_int) function exec_callback(client_data, argc, argv, cols) bind(c
3435
exec_callback = 0
3536
end function exec_callback
3637

38+
! void error_log_callback(void *udp, int err_code, const char *err_msg)
39+
subroutine error_log_callback(udp, err_code, err_msg) bind(c)
40+
type(c_ptr), intent(in), value :: udp
41+
integer(kind=c_int), intent(in), value :: err_code
42+
type(c_ptr), intent(in), value :: err_msg
43+
character(len=:), allocatable :: msg
44+
45+
call c_f_str_ptr(err_msg, msg)
46+
print '(a)', repeat('-', 64)
47+
print '("ERROR ", i0, ": ", a)', err_code, msg
48+
print '(a)', repeat('-', 64)
49+
if (allocated(msg)) deallocate (msg)
50+
end subroutine error_log_callback
51+
3752
! void update_callback(void* udp, int type, const char *db_name, const char *tbl_name, sqlite3_int64 rowid)
3853
subroutine update_callback(udp, type, db_name, tbl_name, rowid) bind(c)
3954
!! Callback routine that is called whenever a row is inserted, updated,
@@ -81,13 +96,25 @@ program test_sqlite
8196
type(c_ptr) :: stmt ! SQLite statement.
8297
type(c_ptr) :: udp ! User-data pointer.
8398

99+
! Set configuration to single thread.
100+
rc = sqlite3_config(SQLITE_CONFIG_SINGLETHREAD)
101+
if (rc /= SQLITE_OK) stop 'sqlite3_config(): failed'
102+
103+
rc = sqlite3_config(SQLITE_CONFIG_LOG, c_funloc(error_log_callback), c_null_ptr)
104+
if (rc /= SQLITE_OK) stop 'sqlite3_config(): failed'
105+
84106
print '("SQLite library version: ", a)', sqlite3_libversion()
85107
print '("SQLite source ID: ", a)', sqlite3_sourceid()
86108

87109
! Open SQLite database.
88110
rc = sqlite3_open(DB_FILE, db)
89111
if (rc /= SQLITE_OK) stop 'sqlite3_open(): failed'
90112

113+
! Enable WAL mode.
114+
print '("Turning WAL mode on ...")'
115+
rc = journal_mode_wal(db)
116+
if (rc /= SQLITE_OK) print '("Unable to set WAL mode")'
117+
91118
! Register update hook.
92119
udp = sqlite3_update_hook(db, c_funloc(update_callback), c_null_ptr)
93120

@@ -172,6 +199,32 @@ program test_sqlite
172199
rc = sqlite3_close(db)
173200
if (rc /= SQLITE_OK) stop 'sqlite3_close(): failed'
174201
contains
202+
integer function journal_mode_wal(db) result(rc)
203+
!! Enables WAL mode.
204+
type(c_ptr), intent(inout) :: db
205+
character(len=:), allocatable :: buf
206+
integer :: err
207+
type(c_ptr) :: stmt
208+
209+
rc = -1
210+
211+
sql_block: block
212+
err = sqlite3_prepare_v2(db, "PRAGMA journal_mode=WAL", stmt)
213+
if (err /= SQLITE_OK) exit sql_block
214+
215+
err = sqlite3_step(stmt)
216+
if (err /= SQLITE_ROW) exit sql_block
217+
218+
buf = sqlite3_column_text(stmt, 0)
219+
if (.not. allocated(buf)) exit sql_block
220+
if (buf /= 'wal') exit sql_block
221+
222+
rc = 0
223+
end block sql_block
224+
225+
err = sqlite3_finalize(stmt)
226+
end function journal_mode_wal
227+
175228
subroutine print_error(rc, func, errmsg)
176229
integer, intent(in) :: rc
177230
character(len=*), intent(in) :: func
@@ -206,7 +259,7 @@ subroutine print_values(stmt, ncols)
206259
end if
207260

208261
case default
209-
write (*, '(" unsupported")', advance='no')
262+
write (*, '(" not implemented")', advance='no')
210263
end select
211264
end do
212265

0 commit comments

Comments
 (0)