Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / test-suite / tests / foreign.test

diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 540effb..8ba989e 100644 (file)
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -51,6 +51,10 @@
   (pass-if "null-pointer? %null-pointer"
     (null-pointer? %null-pointer))
 
+  (pass-if-exception "dereference-pointer %null-pointer"
+    exception:null-pointer-error
+    (dereference-pointer %null-pointer))
+
   (pass-if-exception "pointer->bytevector %null-pointer"
     exception:null-pointer-error
     (pointer->bytevector %null-pointer 7)))
@@ -68,17 +72,19 @@
     (equal? (make-pointer 123) (make-pointer 123)))
 
   (pass-if "equal? modulo finalizer"
-    (let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link))))
+    (let ((finalizer (false-if-exception
+                      (dynamic-func "scm_is_pair" (dynamic-link)))))
       (if (not finalizer)
-          (throw 'unresolved)                     ; probably Windows
+          (throw 'unresolved)               ;  Windows or a static build
           (equal? (make-pointer 123)
                   (make-pointer 123 finalizer)))))
 
   (pass-if "equal? modulo finalizer (set-pointer-finalizer!)"
-    (let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link)))
+    (let ((finalizer (false-if-exception
+                      (dynamic-func "scm_is_pair" (dynamic-link))))
           (ptr       (make-pointer 123)))
       (if (not finalizer)
-          (throw 'unresolved)                     ; probably Windows
+          (throw 'unresolved)                ; Windows or a static build
           (begin
             (set-pointer-finalizer! ptr finalizer)
             (equal? (make-pointer 123) ptr)))))
@@ -222,9 +228,13 @@
 
   (define qsort
     ;; Bindings for libc's `qsort' function.
-    (pointer->procedure void
-                        (dynamic-func "qsort" (dynamic-link))
-                        (list '* size_t size_t '*)))
+    ;; On some platforms, such as MinGW, `qsort' is visible only if
+    ;; linking with `-export-dynamic'.  Just skip these tests when it's
+    ;; not visible.
+    (false-if-exception
+     (pointer->procedure void
+                         (dynamic-func "qsort" (dynamic-link))
+                         (list '* size_t size_t '*))))
 
   (define (dereference-pointer-to-byte ptr)
     (let ((b (pointer->bytevector ptr 1)))
@@ -234,7 +244,7 @@
     '(7 1 127 3 5 4 77 2 9 0))
 
   (pass-if "qsort"
-    (if (defined? 'procedure->pointer)
+    (if (and qsort (defined? 'procedure->pointer))
         (let* ((called? #f)
                (cmp     (lambda (x y)
                           (set! called? #t)
@@ -252,7 +262,7 @@
   (pass-if-exception "qsort, wrong return type"
     exception:wrong-type-arg
 
-    (if (defined? 'procedure->pointer)
+    (if (and qsort (defined? 'procedure->pointer))
         (let* ((cmp     (lambda (x y) #f)) ; wrong return type
                (ptr     (procedure->pointer int cmp (list '* '*)))
                (bv      (u8-list->bytevector input)))
@@ -264,7 +274,7 @@
   (pass-if-exception "qsort, wrong arity"
     exception:wrong-num-args
 
-    (if (defined? 'procedure->pointer)
+    (if (and qsort (defined? 'procedure->pointer))
         (let* ((cmp     (lambda (x y z) #f)) ; wrong arity
                (ptr     (procedure->pointer int cmp (list '* '*)))
                (bv      (u8-list->bytevector input)))
@@ -332,6 +342,10 @@
     (= (sizeof (list int8 double))
        (+ (alignof double) (sizeof double))))
 
+  (pass-if "sizeof { double, int8 }"
+    (= (sizeof (list double int8))
+       (+ (alignof double) (sizeof double))))
+
   (pass-if "sizeof { short, int, long, pointer }"
     (let ((layout (list short int long '*)))
       (>= (sizeof layout)