Doesn't run argout test if (system foreign), and in particular, bytevector->pointer doesn't exist
This commit is contained in:
parent
a4ec4df5c9
commit
567f944129
1 changed files with 10 additions and 6 deletions
|
|
@ -2,15 +2,19 @@
|
|||
;; https://www.gnu.org/software/guile/manual/html_node/Void-Pointers-and-Byte-Access.html
|
||||
(dynamic-call "scm_init_argout_module" (dynamic-link "./libargout"))
|
||||
|
||||
(use-modules (srfi srfi-4) (system foreign))
|
||||
|
||||
(define initial-value 42)
|
||||
(define some-s32-data (s32vector initial-value))
|
||||
|
||||
(if (not (= (incp (bytevector->pointer some-s32-data)) initial-value))
|
||||
(error "Didn't read s32 data" initial-value some-s32-data))
|
||||
;; if we're running guile 1.8, then bytevector->pointer won't exist and this
|
||||
;; test is useless
|
||||
(if (module-variable (resolve-module '(system foreign)) 'bytevector->pointer)
|
||||
(begin
|
||||
(use-modules (srfi srfi-4) (system foreign))
|
||||
|
||||
(if (not (= (s32vector-ref some-s32-data 0) (+ initial-value 1)))
|
||||
(error "Failed to increment s32 data" some-s32-data))
|
||||
(if (not (= (incp (bytevector->pointer some-s32-data)) initial-value))
|
||||
(error "Didn't read s32 data" initial-value some-s32-data))
|
||||
|
||||
(if (not (= (s32vector-ref some-s32-data 0) (+ initial-value 1)))
|
||||
(error "Failed to increment s32 data" some-s32-data))))
|
||||
|
||||
(exit 0)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue