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

Can't recursively search DLLs with FFI on Cygwin

* doc/ref/api-foreign.text (dynamic-link): document problems with recursive DLLs.
* test-suite/standalone/test-ffi (global): with Cygwin, dynamic-link C library explicitly
* test-suite/standalone/test-foreign-object-scm (libc-ptr): with Cygwin, link C library explicitly
* test-suite/tests/foreign.test (qsort): with Cygwin, link C library explicitly
This commit is contained in:
Mike Gran 2017-03-05 12:26:57 -08:00
parent efd6e3f40c
commit 4ce31fd387
4 changed files with 40 additions and 7 deletions

View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000-2004, 2007-2014, 2016
@c Copyright (C) 1996, 1997, 2000-2004, 2007-2014, 2016-2017
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -89,6 +89,11 @@ When @var{library} is omitted, a @dfn{global symbol handle} is returned. This
handle provides access to the symbols available to the program at run-time,
including those exported by the program itself and the shared libraries already
loaded.
Note that on hosts that use dynamic-link libraries (DLLs), the global
symbol handle may not be able to provide access to symbols from
recursively-loaded DLLs. Only exported symbols from those DLLs directly
loaded by the program may be available.
@end deffn
@deffn {Scheme Procedure} dynamic-object? obj

View file

@ -3,7 +3,7 @@ exec guile -q -s "$0" "$@"
!#
;;; test-ffi --- Foreign function interface. -*- Scheme -*-
;;;
;;; Copyright (C) 2010 Free Software Foundation, Inc.
;;; Copyright (C) 2010, 2017 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
@ -263,7 +263,15 @@ exec guile -q -s "$0" "$@"
(if (defined? 'setlocale)
(setlocale LC_ALL "C"))
(define global (dynamic-link))
(define global (cond
((string-contains %host-type "cygwin")
;; On Cygwin, dynamic-link doesn't search recursively
;; into linked DLLs. Thus one needs to link to the core
;; C library DLL explicitly.
(dynamic-link "cygwin1"))
(else
(dynamic-link))))
(define strerror
(pointer->procedure '* (dynamic-func "strerror" global)

View file

@ -3,7 +3,7 @@ exec guile -q -s "$0" "$@"
!#
;;; test-foreign-object-scm --- Foreign object interface. -*- Scheme -*-
;;;
;;; Copyright (C) 2014 Free Software Foundation, Inc.
;;; Copyright (C) 2014, 2017 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
@ -26,7 +26,17 @@ exec guile -q -s "$0" "$@"
(define (libc-ptr name)
(catch #t
(lambda () (dynamic-pointer name (dynamic-link)))
(lambda ()
(dynamic-pointer name
(cond
((string-contains %host-type "cygwin")
;; On Cygwin, dynamic-link does not search
;; recursively into linked DLLs. Thus, one
;; needs to link to the core C library DLL
;; explicitly.
(dynamic-link "cygwin1"))
(else
(dynamic-link)))))
(lambda (k . args)
(print-exception (current-error-port) #f k args)
(write "Skipping test.\n" (current-error-port))

View file

@ -1,6 +1,6 @@
;;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2010, 2011, 2012, 2013, 2017 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
@ -233,7 +233,17 @@
;; not visible.
(false-if-exception
(pointer->procedure void
(dynamic-func "qsort" (dynamic-link))
(dynamic-func "qsort"
(cond
((string-contains %host-type "cygwin")
;; On Cygwin, dynamic-link does
;; not search recursively into
;; linked DLLs. Thus, one needs
;; to link to the core C
;; library DLL explicitly.
(dynamic-link "cygwin1"))
(else
(dynamic-link))))
(list '* size_t size_t '*))))
(define (dereference-pointer-to-byte ptr)