Skip to content

Commit 8dbb78f

Browse files
interkosmosinterkosmos
committed
Refactoring.
1 parent f65e8eb commit 8dbb78f

File tree

3 files changed

+81
-68
lines changed

3 files changed

+81
-68
lines changed

‎README.md‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,13 +54,18 @@ CREATE TABLE example_table (
5454
```
5555

5656
The program opens a database `example.db`, creates the table `example_table`,
57-
inserts some values, then reads them back in, and prints them to console:
57+
inserts some values, then reads them back in, and prints them to console.
58+
59+
The (optional) module `sqlite_util` contains C interoperability
60+
functions/interfaces to convert C char pointer to Fortran allocatable
61+
character.
5862

5963
```fortran
6064
! example.f90
6165
program example
6266
use, intrinsic :: iso_c_binding
6367
use :: sqlite
68+
use :: sqlite_util
6469
character(len=:), allocatable :: errmsg
6570
integer :: rc
6671
type(c_ptr) :: db

‎src/sqlite.f90‎

Lines changed: 74 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,53 @@
44
!
55
! Author: Philipp Engel
66
! Licence: ISC
7+
module sqlite_util
8+
use, intrinsic :: iso_c_binding
9+
implicit none (type, external)
10+
private
11+
12+
public :: c_f_str_ptr
13+
public :: c_strlen
14+
15+
private :: copy
16+
17+
interface
18+
function c_strlen(str) bind(c, name='strlen')
19+
import :: c_ptr, c_size_t
20+
implicit none
21+
type(c_ptr), intent(in), value :: str
22+
integer(c_size_t) :: c_strlen
23+
end function c_strlen
24+
end interface
25+
contains
26+
pure function copy(a)
27+
character, intent(in) :: a(:)
28+
character(len=size(a)) :: copy
29+
integer(kind=8) :: i
30+
31+
do i = 1, size(a)
32+
copy(i:i) = a(i)
33+
end do
34+
end function copy
35+
36+
subroutine c_f_str_ptr(c_str, f_str)
37+
type(c_ptr), intent(in) :: c_str
38+
character(len=:), allocatable, intent(out) :: f_str
39+
character(kind=c_char), pointer :: ptrs(:)
40+
integer(kind=8) :: sz
41+
42+
if (.not. c_associated(c_str)) return
43+
sz = c_strlen(c_str)
44+
if (sz < 0) return
45+
call c_f_pointer(c_str, ptrs, [ sz ])
46+
allocate (character(len=sz) :: f_str)
47+
f_str = copy(ptrs)
48+
end subroutine c_f_str_ptr
49+
end module sqlite_util
50+
751
module sqlite
852
use, intrinsic :: iso_c_binding
53+
use :: sqlite_util
954
implicit none (type, external)
1055
private
1156

@@ -108,35 +153,35 @@ module sqlite
108153
integer, parameter, public :: SQLITE_DBSTATUS_CACHE_SPILL = 12
109154
integer, parameter, public :: SQLITE_DBSTATUS_MAX = 12 ! Largest defined DBSTATUS.
110155

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
156+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SINGLETHREAD = 1 ! nil
157+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MULTITHREAD = 2 ! nil
158+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SERIALIZED = 3 ! nil
159+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MALLOC = 4 ! sqlite3_mem_methods*
160+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETMALLOC = 5 ! sqlite3_mem_methods*
161+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SCRATCH = 6 ! No longer used
162+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PAGECACHE = 7 ! void*, int sz, int N
163+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_HEAP = 8 ! void*, int nByte, int min
164+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MEMSTATUS = 9 ! boolean
165+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MUTEX = 10 ! sqlite3_mutex_methods*
166+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETMUTEX = 11 ! sqlite3_mutex_methods*
167+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_CHUNKALLOC = 12 ! unused
168+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_LOOKASIDE = 13 ! int int
169+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE = 14 ! no-op
170+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETPCACHE = 15 ! no-op
171+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_LOG = 16 ! xFunc, void*
172+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_URI = 17 ! int
173+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE2 = 18 ! sqlite3_pcache_methods2*
174+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_GETPCACHE2 = 19 ! sqlite3_pcache_methods2*
175+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_COVERING_INDEX_SCAN = 20 ! int
176+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SQLLOG = 21 ! xSqllog, void*
177+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MMAP_SIZE = 22 ! sqlite3_int64, sqlite3_int64
178+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_WIN32_HEAPSIZE = 23 ! int nByte
179+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PCACHE_HDRSZ = 24 ! int *psz
180+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_PMASZ = 25 ! unsigned int szPma
181+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_STMTJRNL_SPILL = 26 ! int nByte
182+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SMALL_MALLOC = 27 ! boolean
183+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_SORTERREF_SIZE = 28 ! int nByte
184+
integer(kind=c_int), parameter, public :: SQLITE_CONFIG_MEMDB_MAXSIZE = 29 ! sqlite3_int64
140185

141186
integer(kind=c_size_t), parameter, public :: SQLITE_STATIC = 0
142187
integer(kind=c_size_t), parameter, public :: SQLITE_TRANSIENT = -1
@@ -194,11 +239,6 @@ module sqlite
194239
public :: sqlite3_str_value
195240
public :: sqlite3_update_hook
196241

197-
public :: c_f_str_ptr
198-
public :: c_strlen
199-
200-
private :: copy
201-
202242
interface
203243
! int sqlite3_bind_double(sqlite3_stmt *stmt, int idx, double val)
204244
function sqlite3_bind_double(stmt, idx, val) bind(c, name='sqlite3_bind_double')
@@ -600,45 +640,12 @@ subroutine sqlite3_str_reset(str) bind(c, name='slqite3_str_reset')
600640
end subroutine sqlite3_str_reset
601641
end interface
602642

603-
interface
604-
function c_strlen(str) bind(c, name='strlen')
605-
import :: c_ptr, c_size_t
606-
implicit none
607-
type(c_ptr), intent(in), value :: str
608-
integer(c_size_t) :: c_strlen
609-
end function c_strlen
610-
end interface
611-
612643
interface sqlite3_config
613644
module procedure :: sqlite3_config_funptr_ptr
614645
module procedure :: sqlite3_config_int
615646
module procedure :: sqlite3_config_null
616647
end interface
617648
contains
618-
pure function copy(a)
619-
character, intent(in) :: a(:)
620-
character(len=size(a)) :: copy
621-
integer(kind=8) :: i
622-
623-
do i = 1, size(a)
624-
copy(i:i) = a(i)
625-
end do
626-
end function copy
627-
628-
subroutine c_f_str_ptr(c_str, f_str)
629-
type(c_ptr), intent(in) :: c_str
630-
character(len=:), allocatable, intent(out) :: f_str
631-
character(kind=c_char), pointer :: ptrs(:)
632-
integer(kind=8) :: sz
633-
634-
if (.not. c_associated(c_str)) return
635-
sz = c_strlen(c_str)
636-
if (sz < 0) return
637-
call c_f_pointer(c_str, ptrs, [ sz ])
638-
allocate (character(len=sz) :: f_str)
639-
f_str = copy(ptrs)
640-
end subroutine c_f_str_ptr
641-
642649
function sqlite3_bind_text(stmt, idx, val, destructor)
643650
!! Binds text to column. This wrapper passes destructor
644651
!! `SQLITE_TRANSIENT` by default!

‎test/test_sqlite.f90‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
module callbacks
33
use, intrinsic :: iso_c_binding
44
use :: sqlite
5+
use :: sqlite_util
56
implicit none
67
private
78

0 commit comments

Comments
 (0)