Eli Zaretskii <e...@gnu.org> skribis:
> The tests in foreign.test failed because they need to be able to call
> C functions in Guile itself. According to libtool documentation, this
> requires to link with -export-dynamic, so this is needed:
>
> --- libguile/Makefile.am~ 2013-04-03 15:11:28.000000000 +0300
> +++ libguile/Makefile.am 2013-06-13 13:34:27.545323200 +0300
> @@ -113,7 +113,7 @@
> guile_SOURCES = guile.c
> guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
> guile_LDADD = libguile-@GUILE_EFFECTIVE_VERSION@.la
> -guile_LDFLAGS = $(GUILE_CFLAGS)
> +guile_LDFLAGS = $(GUILE_CFLAGS) -export-dynamic
>
> libguile_@GUILE_EFFECTIVE_VERSION@_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
Rather than exporting more symbols just for the sake of those test
cases, I changed the test suite to skip those test cases when ‘qsort’ is
not visible:
commit 09fb52b6c908606a0f4a5d5d118128c02de606c4
Author: Ludovic Courtès <l...@gnu.org>
Date: Sun Jun 16 16:52:38 2013 +0200
tests: Skip FFI tests that use `qsort' when it's not accessible.
* test-suite/tests/foreign.test ("procedure->pointer")[qsort]: Wrap in
`false-if-exception'.
["qsort", "qsort, wrong return type", "qsort, wrong arity"]: Throw
'unresolved when QSORT if #f.
Reported by Eli Zaretskii <e...@gnu.org>.
Modified test-suite/tests/foreign.test
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 66fd3d5..4b129db 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -224,9 +224,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)))
@@ -236,7 +240,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)
@@ -254,7 +258,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)))
@@ -266,7 +270,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)))
> The following patch prevents test failure on systems that don't
> support symlinks, and thus test-symlink file is not created and does
> not exist there.
>
> --- test-suite/tests/filesys.test~0 2013-04-09 09:52:31.000000000 +0300
> +++ test-suite/tests/filesys.test 2013-06-13 07:49:51.567974100 +0300
> @@ -222,4 +222,5 @@
> (throw 'unresolved)))))
>
> (delete-file (test-file))
> -(delete-file (test-symlink))
> +(if (file-exists? (test-symlink))
> + (delete-file (test-symlink)))
Applied, thanks!
Ludo’.
