Coverage report: /development/source/library/com/dydra/gitlab/dydra-cgi/ffi/lisp/rdfcache/transaction.lisp

KindCoveredAll%
expression99204 48.5
branch28 25.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :rdfcache)
2
 
3
 ;;; Transaction API: Constructors
4
 
5
 (defun/deprecated clone-transaction (transaction-pointer &optional transaction-uuid-string)
6
   (declare (type foreign-pointer transaction-pointer)
7
            (type (or null string) transaction-uuid-string))
8
   (with-checked-pointer-result "rdfcache_transaction_clone"
9
     (if (null transaction-uuid-string)
10
         (%%transaction-clone transaction-pointer (null-pointer))
11
         (with-uuid (transaction-uuid)
12
           (%%uuid-init transaction-uuid)
13
           (with-checked-errno-result "rdfcache_uuid_parse"
14
             (%%uuid-parse transaction-uuid transaction-uuid-string))
15
           (%%transaction-clone transaction-pointer transaction-uuid)))))
16
 
17
 ;;; Transaction API: Accessors
18
 
19
 (defmacro transaction-slot-pointer (transaction-var slot-name)
20
   `(foreign-slot-pointer ,transaction-var 'transaction ,slot-name))
21
 
22
 (defmacro transaction-slot-value (transaction-var slot-name)
23
   `(foreign-slot-value ,transaction-var 'transaction ,slot-name))
24
 
25
 (defmacro transaction-status (transaction-var)
26
   `(transaction-slot-value ,transaction-var 'status))
27
 
28
 (defmacro transaction-uuid-pointer (transaction-var)
29
   `(transaction-slot-value ,transaction-var 'uuid))
30
 
31
 (defmacro transaction-uuid-string (transaction-var)
32
   `(uuid-to-string (transaction-uuid-pointer ,transaction-var)))
33
 
34
 (defmacro transaction-repository-name (transaction-var)
35
   `(transaction-slot-value ,transaction-var 'repository-name))
36
 
37
 (defmacro transaction-parent-revision-p (transaction-var)
38
   `(not (= (%%uuid-empty (transaction-parent-revision-uuid-pointer ,transaction-var)) 1)))
39
 
40
 (defmacro transaction-parent-revision-uuid-pointer (transaction-var)
41
   `(transaction-slot-value ,transaction-var 'parent-revision-uuid))
42
 
43
 (defmacro transaction-parent-revision-uuid-string (transaction-var)
44
   `(uuid-to-string (transaction-parent-revision-uuid-pointer ,transaction-var)))
45
 
46
 (defmacro transaction-delete-count (transaction-var)
47
   `(transaction-slot-value ,transaction-var 'delete-count))
48
 
49
 (defmacro transaction-insert-count (transaction-var)
50
   `(transaction-slot-value ,transaction-var 'insert-count))
51
 
52
 ;;; Transaction API: Operations
53
 
54
 (defun %make-transaction (transaction-uuid-string repository-name &key revision-id operation read-only-p)
55
   (declare (ignore operation)) ;; not used at present (for future extensibility)
56
   (with-uuid (transaction-uuid)
57
     (%%uuid-init transaction-uuid)
58
     (etypecase transaction-uuid-string
59
       (null)
60
       (foreign-pointer)
61
       (string (with-checked-errno-result "rdfcache_uuid_parse"
62
                 (%%uuid-parse transaction-uuid transaction-uuid-string))))
63
     (etypecase repository-name
64
       (null (setf repository-name (null-pointer)))
65
       (foreign-pointer)
66
       (string (setf repository-name (foreign-string-alloc repository-name))))
67
     (etypecase revision-id
68
       (null (setf revision-id (null-pointer)))
69
       (foreign-pointer)
70
       (string (setf revision-id (foreign-string-alloc revision-id))))
71
     (let ((transaction-pointer (foreign-alloc 'transaction)))
72
       (with-checked-errno-result "rdfcache_transaction_init2"
73
         (%%transaction-init transaction-pointer
74
                             (if transaction-uuid-string
75
                                 transaction-uuid
76
                                 (null-pointer))
77
                             repository-name
78
                             revision-id
79
                             (if read-only-p 0 1)))
80
       transaction-pointer)))
81
 
82
 (defun %destroy-transaction (%transaction)
83
   %transaction) ;; FIXME: memory leak?
84
 
85
 (defun initialize-transaction (transaction-pointer transaction-uuid-string repository-name &key revision-id operation read-only-p)
86
   (declare (ignore operation)) ;; not used at present (for future extensibility)
87
   (declare (type foreign-pointer transaction-pointer)
88
            (type (or null string) transaction-uuid-string))
89
   (etypecase repository-name
90
     (null (setf repository-name (null-pointer)))
91
     (foreign-pointer)
92
     (string (setf repository-name (foreign-string-alloc repository-name))))
93
   (etypecase revision-id
94
     (null (setf revision-id (null-pointer)))
95
     (foreign-pointer)
96
     (string (setf revision-id (foreign-string-alloc revision-id))))
97
   (with-checked-errno-result "rdfcache_transaction_init"
98
     (if (null transaction-uuid-string)
99
         (%%transaction-init transaction-pointer
100
                             (null-pointer) ;; generated by libspocq
101
                             repository-name
102
                             revision-id
103
                             (if read-only-p 0 1))
104
         (with-uuid (transaction-uuid)
105
           (%%uuid-init transaction-uuid)
106
           (with-checked-errno-result "rdfcache_uuid_parse"
107
             (%%uuid-parse transaction-uuid transaction-uuid-string))
108
           (%%transaction-init transaction-pointer
109
                               transaction-uuid
110
                               repository-name
111
                               revision-id
112
                               (if read-only-p 0 1))))))
113
 
114
 (defun reset-transaction (transaction-pointer)
115
   (declare (type foreign-pointer transaction-pointer))
116
   (with-checked-errno-result "rdfcache_transaction_dispose"
117
     (%%transaction-dispose transaction-pointer)))
118
 
119
 (defun begin-transaction (transaction-pointer)
120
   (declare (type foreign-pointer transaction-pointer))
121
   (with-checked-errno-result "rdfcache_transaction_begin"
122
     (%%transaction-begin transaction-pointer)))
123
 
124
 (defun abort-transaction (transaction-pointer)
125
   (declare (type foreign-pointer transaction-pointer))
126
   (with-checked-errno-result "rdfcache_transaction_abort"
127
     (%%transaction-abort transaction-pointer)))
128
 
129
 (defun commit-transaction (transaction-pointer)
130
   (declare (type foreign-pointer transaction-pointer))
131
   (with-checked-errno-result "rdfcache_transaction_commit"
132
     (%%transaction-commit transaction-pointer)))
133
 
134
 (defun insert-statement (transaction-pointer context-number subject-number predicate-number object-number)
135
   (declare (type foreign-pointer transaction-pointer)
136
            (type fixnum context-number subject-number predicate-number object-number))
137
   (with-checked-errno-result "rdfcache_transaction_insert_fast"
138
     (%%transaction-insert transaction-pointer context-number subject-number predicate-number object-number)))
139
 
140
 (defun delete-statement (transaction-pointer context-number subject-number predicate-number object-number)
141
   (declare (type foreign-pointer transaction-pointer)
142
            (type fixnum context-number subject-number predicate-number object-number))
143
   (with-checked-errno-result "rdfcache_transaction_delete_fast"
144
     (%%transaction-delete transaction-pointer context-number subject-number predicate-number object-number)))
145
 
146
 (defun fetch-term* (transaction-pointer term-number term-pointer)
147
   "Given a valid term number, copy its fields into the provided term structure."
148
   (declare (type (or foreign-pointer null) transaction-pointer)
149
            (type fixnum term-number)
150
            (type foreign-pointer term-pointer))
151
   (if (null transaction-pointer)
152
       (fetch-term term-number term-pointer)
153
       (with-checked-pointers (transaction-pointer term-pointer)
154
         (with-checked-errno-result "rdfcache_transaction_fetch_term"
155
           (%%transaction-fetch-term transaction-pointer term-number term-pointer)))))
156
 
157
 (defun lookup-term (transaction-pointer term-type term-value term-language term-datatype)
158
   (declare (type foreign-pointer transaction-pointer)
159
            (type keyword term-type)
160
            (type (or foreign-pointer string null) term-value term-language term-datatype))
161
   (with-checked-pointer (transaction-pointer)
162
     (%%transaction-lookup-term transaction-pointer
163
                                (or term-type (null-pointer))
164
                                (or term-value (null-pointer))
165
                                (or term-language (null-pointer))
166
                                (or term-datatype (null-pointer)))))
167
 
168
 (defun intern-term (transaction-pointer term-type term-value term-language term-datatype)
169
   (declare (type (or foreign-pointer null) transaction-pointer)
170
            (type keyword term-type)
171
            (type (or foreign-pointer string null) term-value term-language term-datatype))
172
   (if (null transaction-pointer)
173
       (%%intern-term term-type
174
                      (or term-value (null-pointer))
175
                      (or term-language (null-pointer))
176
                      (or term-datatype (null-pointer)))
177
       (with-checked-pointer (transaction-pointer)
178
         (%%transaction-intern-term transaction-pointer
179
                                    term-type
180
                                    (or term-value (null-pointer))
181
                                    (or term-language (null-pointer))
182
                                    (or term-datatype (null-pointer))))))
183
 
184
 ;;; Transaction API: Macros
185
 
186
 (defmacro with-transaction ((transaction-var repository-name &key (read-only-p t)) &body body)
187
   (let ((result-var (gensym)))
188
     `(with-foreign-object (,transaction-var '(:struct transaction))
189
        (let ((,result-var nil))
190
           (initialize-transaction ,transaction-var nil ,repository-name :read-only-p ,read-only-p)
191
           (begin-transaction ,transaction-var)
192
           (unwind-protect
193
             (setf ,result-var (progn ,@body))
194
             (progn (abort-transaction ,transaction-var)
195
                    (reset-transaction ,transaction-var)
196
                    ,result-var))))))
197
 
198
 ;;; Transaction API: Debugging
199
 
200
 (defun print-transaction (transaction-pointer &optional (stream *standard-output*))
201
   (print-unreadable-object (transaction-pointer stream :identity nil :type nil)
202
     (format stream "rdfcache:transaction ~8,'0x: status ~s uuid ~s repository-name ~s parent-revision-uuid ~s delete-count ~s insert-count ~s~%"
203
             (pointer-address transaction-pointer)
204
             (transaction-status transaction-pointer)
205
             (transaction-uuid-string transaction-pointer)
206
             (transaction-repository-name transaction-pointer)
207
             (transaction-parent-revision-uuid-string transaction-pointer)
208
             (transaction-delete-count transaction-pointer)
209
             (transaction-insert-count transaction-pointer))
210
     (finish-output stream)))