mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

tests: Skip FFI tests that use `qsort' when it's not accessible.

Browse source 
* 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 <eliz@gnu.org>.
This commit is contained in:
Ludovic Courtès 2013-06-16 16:52:38 +02:00
parent 556d35af88
commit 09fb52b6c9
1 changed files with 10 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

16
test-suite/tests/foreign.test
View file

@ -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)))