[Guile-commits] 01/01: Can't recursively search DLLs with FFI on Cygwin

[Mike Gran]

mike121 pushed a commit to branch master
in repository guile.

commit 4ce31fd387e89c8f64716866705a5a34651506ea
Author: Mike Gran <address@hidden>
Date:   Sun Mar 5 12:26:57 2017 -0800

    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
---
 doc/ref/api-foreign.texi                      |  7 ++++++-
 test-suite/standalone/test-ffi                | 12 ++++++++++--
 test-suite/standalone/test-foreign-object-scm | 14 ++++++++++++--
 test-suite/tests/foreign.test                 | 14 ++++++++++++--
 4 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index 5279022..2f5375d 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000-2004, 2007-2014, 2016
address@hidden 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
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 0a91f63..0e6ab45 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -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)
diff --git a/test-suite/standalone/test-foreign-object-scm 
b/test-suite/standalone/test-foreign-object-scm
index 7e4bd85..fd4669a 100755
--- a/test-suite/standalone/test-foreign-object-scm
+++ b/test-suite/standalone/test-foreign-object-scm
@@ -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))
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index c53c044..67b5c37 100644
--- 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, 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)