summaryrefslogtreecommitdiff
path: root/test-suite/tests/foreign.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/foreign.test')
-rw-r--r--test-suite/tests/foreign.test54
1 files changed, 53 insertions, 1 deletions
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 3569c8a52..60b466e1c 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -28,6 +28,14 @@
#:use-module (test-suite lib))
+(with-test-prefix "dynamic-pointer"
+
+ (pass-if-exception
+ "error message"
+ '(misc-error . "^Symbol not found")
+ (dynamic-func "does_not_exist___" (dynamic-link))))
+
+
(with-test-prefix "null pointer"
(pass-if "pointer?"
@@ -67,6 +75,17 @@
(not (equal? (make-pointer 123) (make-pointer 456)))))
+(with-test-prefix "pointer<->scm"
+
+ (pass-if "immediates"
+ (equal? (pointer->scm (scm->pointer #\newline))
+ #\newline))
+
+ (pass-if "non-immediates"
+ (equal? (pointer->scm (scm->pointer "Hello, world!"))
+ "Hello, world!")))
+
+
(define-wrapped-pointer-type foo
foo?
wrap-foo unwrap-foo
@@ -134,7 +153,18 @@
(pass-if "bijection [latin1]"
(with-latin1-locale
(let ((s "Szép jó napot!"))
- (string=? s (pointer->string (string->pointer s)))))))
+ (string=? s (pointer->string (string->pointer s))))))
+
+ (pass-if "bijection, utf-8"
+ (let ((s "hello, world"))
+ (string=? s (pointer->string (string->pointer s "utf-8")
+ -1 "utf-8"))))
+
+ (pass-if "bijection, utf-8 [latin1]"
+ (let ((s "Szép jó napot!"))
+ (string=? s (pointer->string (string->pointer s "utf-8")
+ -1 "utf-8")))))
+
(with-test-prefix "pointer->procedure"
@@ -214,6 +244,16 @@
(arg3 (map (cut / <> 4.0) (iota 123 100 4))))
(equal? (map proc arg1 arg2 arg3)
(map proc* arg1 arg2 arg3)))
+ (throw 'unresolved)))
+
+ (pass-if "procedures returning void"
+ (if (defined? 'procedure->pointer)
+ (let* ((called? #f)
+ (proc (lambda () (set! called? #t)))
+ (pointer (procedure->pointer void proc '()))
+ (proc* (pointer->procedure void pointer '())))
+ (proc*)
+ called?)
(throw 'unresolved))))
@@ -228,6 +268,11 @@
(>= (sizeof layout)
(reduce + 0.0 (map sizeof layout)))))
+ (pass-if "alignof { int8, double, int8 }"
+ ;; alignment of the most strictly aligned component
+ (let ((layout (list int8 double int8)))
+ (= (alignof layout) (alignof double))))
+
(pass-if "parse-c-struct"
(let ((layout (list int64 uint8))
(data (list -300 43)))
@@ -268,4 +313,11 @@
(data (list 77 %null-pointer -42 3.14)))
(equal? (parse-c-struct (make-c-struct layout data)
layout)
+ data)))
+
+ (pass-if "int8, { int8, double, int8 }, int16"
+ (let ((layout (list int8 (list int8 double int8) int16))
+ (data (list 77 (list 42 4.2 55) 88)))
+ (equal? (parse-c-struct (make-c-struct layout data)
+ layout)
data))))