test/test-ffi.sgl — sigil-ffi

1;;; Tests for (sigil ffi)

2;;;

3;;; These tests require dynamic loading (dlopen) support. On static musl

4;;; builds, dlopen is stubbed out and c-library will fail. We detect this

5;;; at load time and skip all tests gracefully.

7(import (sigil core)

8 (sigil test)

9 (sigil ffi))

11;; Probe whether dynamic loading works on this platform.

12(define has-dlopen?

13 (guard (exn (#t #f))

14 (let ((lib (c-library #f)))

15 (c-library-close lib)

16 #t)))

18;; ============================================================

19;; Type Constants (these don't need dlopen)

20;; ============================================================

22(test-group "FFI type constants"

23 (test "type constants are integers"

24 (assert-true (integer? ffi/void))

25 (assert-true (integer? ffi/int32))

26 (assert-true (integer? ffi/double))

27 (assert-true (integer? ffi/pointer))

28 (assert-true (integer? ffi/string))

29 (assert-true (integer? ffi/size-t)))

31 (test "c-sizeof returns correct sizes"

32 (assert-equal 8 (c-sizeof ffi/double))

33 (assert-equal 4 (c-sizeof ffi/float))

34 (assert-equal 4 (c-sizeof ffi/int32))

35 (assert-equal 2 (c-sizeof ffi/int16))

36 (assert-equal 1 (c-sizeof ffi/int8))

37 (assert-equal 8 (c-sizeof ffi/int64)))

39 (test "c-alignof returns correct alignments"

40 (assert-equal 8 (c-alignof ffi/double))

41 (assert-equal 4 (c-alignof ffi/float))

42 (assert-equal 4 (c-alignof ffi/int32))

43 (assert-equal 1 (c-alignof ffi/int8))))

45;; ============================================================

46;; Pointer Operations (don't need dlopen)

47;; ============================================================

49(test-group "Pointer operations"

50 (test "null pointer"

51 (assert-true (null-pointer? #f))

52 (assert-true (not (null-pointer? (make-pointer 42)))))

54 (test "make-pointer and pointer-address"

55 (let ((ptr (make-pointer 12345)))

56 (assert-true (pointer? ptr))

57 (assert-equal 12345 (pointer-address ptr))))

59 (test "pointer+"

60 (let ((ptr (make-pointer 1000)))

61 (assert-equal 1008 (pointer-address (pointer+ ptr 8)))))

63 (test "c-alloc and pointer-ref/set!"

64 (let ((ptr (c-alloc 32)))

65 (assert-true (pointer? ptr))

66 (assert-true (not (null-pointer? ptr)))

68 ;; Write and read int32

69 (pointer-set! ptr ffi/int32 0 42)

70 (assert-equal 42 (pointer-ref ptr ffi/int32 0))

72 ;; Write and read double

73 (pointer-set! ptr ffi/double 8 3.14)

74 (let ((val (pointer-ref ptr ffi/double 8)))

75 (assert-true (< (abs (- val 3.14)) 0.001)))

77 ;; Write and read int8

78 (pointer-set! ptr ffi/int8 16 -127)

79 (assert-equal -127 (pointer-ref ptr ffi/int8 16))

81 ;; Write and read uint16

82 (pointer-set! ptr ffi/uint16 18 65535)

83 (assert-equal 65535 (pointer-ref ptr ffi/uint16 18))

85 (c-free ptr)))

87 (test "c-alloc zeroes memory"

88 (let ((ptr (c-alloc 64)))

89 (assert-true (pointer? ptr))

90 (assert-equal 0 (pointer-ref ptr ffi/int32 0))

91 (c-free ptr))))

93;; ============================================================

94;; String Marshaling (don't need dlopen for basic ops)

95;; ============================================================

97(test-group "String marshaling"

98 (test "string->pointer and pointer->string"

99 (let* ((ptr (string->pointer "hello world"))

100 (str (pointer->string ptr)))

101 (assert-equal "hello world" str)

102 (c-free ptr)))

103

104 (test "string->pointer with explicit length"

105 (let* ((ptr (string->pointer "hello\x00;world"))

106 (str (pointer->string ptr 11)))

107 ;; With explicit length, we read past the embedded null

108 (assert-equal 11 (string-length str))

109 (c-free ptr))))

110

111;; ============================================================

112;; Struct Layouts (don't need dlopen)

113;; ============================================================

114

115(test-group "Struct layouts"

116 (define point-layout

117 (c-struct-layout

118 x: ffi/double

119 y: ffi/double

120 z: ffi/double))

121

122 (test "struct size"

123 (assert-equal 24 (c-struct-size point-layout)))

124

125 (test "struct offsets"

126 (assert-equal 0 (c-struct-offset point-layout x:))

127 (assert-equal 8 (c-struct-offset point-layout y:))

128 (assert-equal 16 (c-struct-offset point-layout z:)))

129

130 (test "struct ref and set"

131 (let ((ptr (c-alloc-struct point-layout)))

132 (c-struct-set! ptr point-layout x: 1.5)

133 (c-struct-set! ptr point-layout y: 2.5)

134 (c-struct-set! ptr point-layout z: 3.5)

135 (assert-equal 1.5 (c-struct-ref ptr point-layout x:))

136 (assert-equal 2.5 (c-struct-ref ptr point-layout y:))

137 (assert-equal 3.5 (c-struct-ref ptr point-layout z:))

138 (c-free ptr)))

139

140 (test "struct->dict and dict->struct"

141 (let* ((d (dict x: 10.0 y: 20.0 z: 30.0))

142 (ptr (dict->c-struct d point-layout))

143 (d2 (c-struct->dict ptr point-layout)))

144 (assert-equal 10.0 (dict-ref d2 x:))

145 (assert-equal 20.0 (dict-ref d2 y:))

146 (assert-equal 30.0 (dict-ref d2 z:))

147 (c-free ptr)))

148

149 (test "struct with mixed types"

150 (let ((layout (c-struct-layout

151 id: ffi/int32

152 value: ffi/double

153 flags: ffi/uint8)))

154 (assert-equal 0 (c-struct-offset layout id:))

155 (assert-equal 8 (c-struct-offset layout value:))

156 (assert-equal 16 (c-struct-offset layout flags:))

157

158 (let ((ptr (c-alloc-struct layout)))

159 (c-struct-set! ptr layout id: 42)

160 (c-struct-set! ptr layout value: 3.14)

161 (c-struct-set! ptr layout flags: 255)

162 (assert-equal 42 (c-struct-ref ptr layout id:))

163 (let ((val (c-struct-ref ptr layout value:)))

164 (assert-true (< (abs (- val 3.14)) 0.001)))

165 (assert-equal 255 (c-struct-ref ptr layout flags:))

166 (c-free ptr))))

167

168 (test "with-c-alloc"

169 (let ((result (with-c-alloc point-layout

170 (lambda (ptr)

171 (c-struct-set! ptr point-layout x: 42.0)

172 (c-struct-ref ptr point-layout x:)))))

173 (assert-equal 42.0 result))))

174

175;; ============================================================

176;; Bytevector Bridge (don't need dlopen)

177;; ============================================================

178

179(test-group "Bytevector bridge"

180 (test "pointer->bytevector copies data"

181 (let ((ptr (c-alloc 4)))

182 (pointer-set! ptr ffi/uint8 0 65) ; 'A'

183 (pointer-set! ptr ffi/uint8 1 66) ; 'B'

184 (pointer-set! ptr ffi/uint8 2 67) ; 'C'

185 (pointer-set! ptr ffi/uint8 3 0)

186 (let ((bv (pointer->bytevector ptr 3)))

187 (assert-equal 3 (bytevector-length bv))

188 (assert-equal 65 (bytevector-u8-ref bv 0))

189 (assert-equal 66 (bytevector-u8-ref bv 1))

190 (assert-equal 67 (bytevector-u8-ref bv 2)))

191 (c-free ptr)))

192

193 (test "bytevector->pointer"

194 (let* ((bv (bytevector 1 2 3 4))

195 (ptr (bytevector->pointer bv)))

196 (assert-true (pointer? ptr))

197 (assert-equal 1 (pointer-ref ptr ffi/uint8 0))

198 (assert-equal 2 (pointer-ref ptr ffi/uint8 1))

199 (assert-equal 3 (pointer-ref ptr ffi/uint8 2))

200 (assert-equal 4 (pointer-ref ptr ffi/uint8 3)))))

201

202;; ============================================================

203;; Error Handling

204;; ============================================================

205

206(test-group "Error handling"

207 (test "c-errno returns integer"

208 (assert-true (integer? (c-errno))))

209

210 (test "c-strerror returns string"

211 (assert-true (string? (c-strerror 2))))) ; ENOENT = 2

212

213;; ============================================================

214;; Tests below require dynamic loading (dlopen)

215;; ============================================================

216

217(when has-dlopen?

218

219 (test-group "Library loading"

220 (test "load current process"

221 (let ((libc (c-library #f)))

222 (assert-true (c-library? libc))))

223

224 (test "bad library name raises error"

225 (assert-error (c-library "libnonexistent_12345"))))

226

227 ;; On Linux/glibc, math functions are available in the current process.

228 (test-group "Math functions"

229 (define libc (c-library #f))

230

231 (test "sqrt (double -> double)"

232 (let ((sqrt-fn (c-function libc "sqrt" (list ffi/double) ffi/double)))

233 (assert-equal 3.0 (sqrt-fn 9.0))

234 (assert-equal 12.0 (sqrt-fn 144.0))

235 (assert-equal 0.0 (sqrt-fn 0.0))))

236

237 (test "pow (double double -> double)"

238 (let ((pow-fn (c-function libc "pow" (list ffi/double ffi/double) ffi/double)))

239 (assert-equal 8.0 (pow-fn 2.0 3.0))

240 (assert-equal 1024.0 (pow-fn 2.0 10.0))))

241

242 (test "floor and ceil (double -> double)"

243 (let ((floor-fn (c-function libc "floor" (list ffi/double) ffi/double))

244 (ceil-fn (c-function libc "ceil" (list ffi/double) ffi/double)))

245 (assert-equal 3.0 (floor-fn 3.7))

246 (assert-equal 4.0 (ceil-fn 3.2))))

247

248 (test "fabs (double -> double)"

249 (let ((fabs-fn (c-function libc "fabs" (list ffi/double) ffi/double)))

250 (assert-equal 5.0 (fabs-fn -5.0))

251 (assert-equal 0.0 (fabs-fn 0.0)))))

252

253 (test-group "libc integer functions"

254 (define libc (c-library #f))

255

256 (test "abs (int -> int)"

257 (let ((c-abs (c-function libc "abs" (list ffi/int) ffi/int)))

258 (assert-equal 5 (c-abs -5))

259 (assert-equal 0 (c-abs 0))

260 (assert-equal 42 (c-abs 42))))

261

262 (test "strlen (string -> size_t)"

263 (let ((c-strlen (c-function libc "strlen" (list ffi/string) ffi/size-t)))

264 (assert-equal 5 (c-strlen "hello"))

265 (assert-equal 0 (c-strlen ""))

266 (assert-equal 11 (c-strlen "hello world")))))

267

268 (test-group "String auto-marshaling"

269 (test "ffi/string auto-marshaling"

270 (let* ((libc (c-library #f))

271 (c-strlen (c-function libc "strlen" (list ffi/string) ffi/size-t)))

272 (assert-equal 3 (c-strlen "abc")))))

273

274 (test-group "Symbol lookup"

275 (test "c-symbol raises error on missing symbol"

276 (let ((libc (c-library #f)))

277 (assert-error (c-symbol libc "nonexistent_symbol_12345"))))

278

279 (test "c-symbol? returns #f for missing symbol"

280 (let ((libc (c-library #f)))

281 (assert-true (not (c-symbol? libc "nonexistent_symbol_12345"))))))

282

283 ;; define-c-library must be used at top level — move to conditional block

284 ;; Note: define-c-library expands to top-level defines, so we test it

285 ;; only when dlopen is available.

286 )

287

288;; define-c-library at top level, guarded

289(when has-dlopen?

290 (define-c-library mathlib #f

291 ((math-sqrt "sqrt") (ffi/double) -> ffi/double)

292 ((math-pow "pow") (ffi/double ffi/double) -> ffi/double)))

293

294(when has-dlopen?

295 (test-group "define-c-library"

296 (test "sqrt via define-c-library"

297 (assert-equal 5.0 (math-sqrt 25.0)))

298

299 (test "pow via define-c-library"

300 (assert-equal 1024.0 (math-pow 2.0 10.0)))))

301

302;; ============================================================

303;; Callbacks (require dlopen for qsort test)

304;; ============================================================

305

306(when has-dlopen?

307 (test-group "Callbacks"

308 (define libc (c-library #f))

309

310 (test "qsort with integer comparison callback"

311 (let* ((qsort-fn (c-function libc "qsort"

312 (list ffi/pointer ffi/size-t ffi/size-t ffi/pointer)

313 ffi/void))

314 (cmp (c-callback (list ffi/pointer ffi/pointer) ffi/int

315 (lambda (a b)

316 (- (pointer-ref a ffi/int32 0)

317 (pointer-ref b ffi/int32 0)))))

318 (buf (c-alloc 20)))

319 ;; Fill with unsorted integers

320 (pointer-set! buf ffi/int32 0 5)

321 (pointer-set! buf ffi/int32 4 3)

322 (pointer-set! buf ffi/int32 8 1)

323 (pointer-set! buf ffi/int32 12 4)

324 (pointer-set! buf ffi/int32 16 2)

325 ;; Sort

326 (qsort-fn buf 5 4 cmp)

327 ;; Verify sorted order

328 (assert-equal 1 (pointer-ref buf ffi/int32 0))

329 (assert-equal 2 (pointer-ref buf ffi/int32 4))

330 (assert-equal 3 (pointer-ref buf ffi/int32 8))

331 (assert-equal 4 (pointer-ref buf ffi/int32 12))

332 (assert-equal 5 (pointer-ref buf ffi/int32 16))

333 ;; Cleanup

334 (c-callback-release cmp)

335 (c-free buf)))

336

337 (test "qsort descending order"

338 (let* ((qsort-fn (c-function libc "qsort"

339 (list ffi/pointer ffi/size-t ffi/size-t ffi/pointer)

340 ffi/void))

341 (cmp-desc (c-callback (list ffi/pointer ffi/pointer) ffi/int

342 (lambda (a b)

343 (- (pointer-ref b ffi/int32 0)

344 (pointer-ref a ffi/int32 0)))))

345 (buf (c-alloc 12)))

346 (pointer-set! buf ffi/int32 0 1)

347 (pointer-set! buf ffi/int32 4 3)

348 (pointer-set! buf ffi/int32 8 2)

349 (qsort-fn buf 3 4 cmp-desc)

350 (assert-equal 3 (pointer-ref buf ffi/int32 0))

351 (assert-equal 2 (pointer-ref buf ffi/int32 4))

352 (assert-equal 1 (pointer-ref buf ffi/int32 8))

353 (c-callback-release cmp-desc)

354 (c-free buf)))

355

356 (test "callback-release frees the slot"

357 (let ((cb (c-callback (list ffi/pointer ffi/pointer) ffi/int

358 (lambda (a b) 0))))

359 (assert-true (pointer? cb))

360 (c-callback-release cb)))

361

362 (test "multiple concurrent callbacks"

363 (let* ((cb1 (c-callback (list ffi/pointer ffi/pointer) ffi/int

364 (lambda (a b)

365 (- (pointer-ref a ffi/int32 0)

366 (pointer-ref b ffi/int32 0)))))

367 (cb2 (c-callback (list ffi/pointer ffi/pointer) ffi/int

368 (lambda (a b)

369 (- (pointer-ref b ffi/int32 0)

370 (pointer-ref a ffi/int32 0))))))

371 (assert-true (pointer? cb1))

372 (assert-true (pointer? cb2))

373 ;; Different function pointers

374 (assert-true (not (= (pointer-address cb1) (pointer-address cb2))))

375 (c-callback-release cb1)

376 (c-callback-release cb2)))

377

378 (test "void callback (thunk)"

379 (let* ((called #f)

380 (cb (c-callback '() ffi/void

381 (lambda () (set! called #t)))))

382 (assert-true (pointer? cb))

383 (c-callback-release cb)))

384

385 (test "double callback creates successfully"

386 (let ((cb (c-callback (list ffi/double ffi/double) ffi/double

387 (lambda (a b) (+ a b)))))

388 (assert-true (pointer? cb))

389 (c-callback-release cb)))))

390

391(run-tests)