Skip FFI tests that rely on `-export-dynamic' behavior when not available.

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

diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 6eafe95..540effb 100644 (file)
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -1,6 +1,6 @@
 ;;;; foreign.test --- FFI.           -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -25,6 +25,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:use-module (test-suite lib))
 
 \f
@@ -68,14 +69,19 @@
 
   (pass-if "equal? modulo finalizer"
     (let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link))))
-      (equal? (make-pointer 123)
-              (make-pointer 123 finalizer))))
+      (if (not finalizer)
+          (throw 'unresolved)                     ; probably Windows
+          (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)))
           (ptr       (make-pointer 123)))
-      (set-pointer-finalizer! ptr finalizer)
-      (equal? (make-pointer 123) ptr)))
+      (if (not finalizer)
+          (throw 'unresolved)                     ; probably Windows
+          (begin
+            (set-pointer-finalizer! ptr finalizer)
+            (equal? (make-pointer 123) ptr)))))
 
   (pass-if "not equal?"
     (not (equal? (make-pointer 123) (make-pointer 456)))))
@@ -160,6 +166,29 @@
 \f
 (with-test-prefix "pointer<->string"
 
+  (pass-if-exception "%default-port-conversion-strategy is error"
+    exception:encoding-error
+    (let ((s "χαοσ"))
+      (with-fluids ((%default-port-conversion-strategy 'error))
+        (string->pointer s "ISO-8859-1"))))
+
+  (pass-if "%default-port-conversion-strategy is escape"
+    (let ((s "teĥniko"))
+      (equal? (with-fluids ((%default-port-conversion-strategy 'escape))
+                (pointer->string (string->pointer s "ISO-8859-1")))
+              (format #f "te\\u~4,'0xniko"
+                      (char->integer #\ĥ)))))
+
+  (pass-if "%default-port-conversion-strategy is substitute"
+    (let ((s "teĥniko")
+          (member (negate (negate member))))
+      (member (with-fluids ((%default-port-conversion-strategy 'substitute))
+                (pointer->string (string->pointer s "ISO-8859-1")))
+              '("te?niko"
+
+                ;; This form is found on FreeBSD 8.2 and Darwin 10.8.0.
+                "te^hniko"))))
+
   (pass-if "bijection"
     (let ((s "hello, world"))
       (string=? s (pointer->string (string->pointer s)))))