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
commit 4ce31fd387
4 changed files with 40 additions and 7 deletions

View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @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 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @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, 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 including those exported by the program itself and the shared libraries already
loaded. 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 @end deffn
@deffn {Scheme Procedure} dynamic-object? obj @deffn {Scheme Procedure} dynamic-object? obj

View file

@ -3,7 +3,7 @@ exec guile -q -s "$0" "$@"
!# !#
;;; test-ffi --- Foreign function interface. -*- Scheme -*- ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -263,7 +263,15 @@ exec guile -q -s "$0" "$@"
(if (defined? 'setlocale) (if (defined? 'setlocale)
(setlocale LC_ALL "C")) (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 (define strerror
(pointer->procedure '* (dynamic-func "strerror" global) (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 -*- ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -26,7 +26,17 @@ exec guile -q -s "$0" "$@"
(define (libc-ptr name) (define (libc-ptr name)
(catch #t (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) (lambda (k . args)
(print-exception (current-error-port) #f k args) (print-exception (current-error-port) #f k args)
(write "Skipping test.\n" (current-error-port)) (write "Skipping test.\n" (current-error-port))

View file

@ -1,6 +1,6 @@
;;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -233,7 +233,17 @@
;; not visible. ;; not visible.
(false-if-exception (false-if-exception
(pointer->procedure void (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 '*)))) (list '* size_t size_t '*))))
(define (dereference-pointer-to-byte ptr) (define (dereference-pointer-to-byte ptr)