diff options
Diffstat (limited to 'test-suite/tests/foreign.test')
-rw-r--r-- | test-suite/tests/foreign.test | 54 |
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)))) |