[Guile-commits] branch master updated: On Cygwin, 'lib' DLLs use 'cyg' prefix

[Mike Gran]

This is an automated email from the git hooks/post-receive script.

mike121 pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new 5a1e78a  On Cygwin, 'lib' DLLs use 'cyg' prefix
5a1e78a is described below

commit 5a1e78a27817d339d80f28515bd8a57c7eb6b65e
Author: Mike Gran <spk121@yahoo.com>
AuthorDate: Sat Mar 13 09:09:30 2021 -0800

    On Cygwin, 'lib' DLLs use 'cyg' prefix
    
    When using automake and libtool to build DLLs on Cygwin, libtool
    will rename libXXX to cygXXX. 'load-foreign-library' should
    emulate libltdl behavior and search for DLLs using that convention.
    
    * module/system/foreign-library.scm (lib->cyg): new helper function
      (load-foreign-library): add rename-on-cygwin? option to rename
        libraries using Cygwin semantics
    * test-suite/tests/foreign.test: new test section 'lib->cyg'
    * doc/ref/api-foreign.text: document new rename-on-cygwin? option
        for load-foreign-library
---
 doc/ref/api-foreign.texi          |  6 ++++++
 module/system/foreign-library.scm | 24 +++++++++++++++++++++++-
 test-suite/tests/foreign.test     | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+), 1 deletion(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index e4c0684..2bd460a 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -84,6 +84,7 @@ implemented in the @code{(system foreign-library)} module.
        [#:search-ltdl-library-path?=#t] @
        [#:search-path=search-path] @
        [#:search-system-paths?=#t] [#:lazy?=#t] [#:global=#f]
+       [#:rename-on-cygwin?=#t]
 Find the shared library denoted by @var{library} (a string or @code{#f})
 and link it into the running Guile application.  When everything works
 out, return a Scheme object suitable for representing the linked object
@@ -177,6 +178,11 @@ system to resolve symbols used by the loaded library as 
they are first
 used.  If @var{global?} is true, symbols defined by the loaded library
 will be available when other modules need to resolve symbols; the
 default is @code{#f}, which keeps symbols local.
+
+If @var{rename-on-cygwin?} is true (the default) -- on Cygwin hosts only
+-- the search behavior is modified such that a filename that starts with
+``lib'' will be searched for under the name ``cyg'', as is customary for
+Cygwin.
 @end deffn
 
 The environment variables mentioned above are parsed when the
diff --git a/module/system/foreign-library.scm 
b/module/system/foreign-library.scm
index eaeb267..d53e293 100644
--- a/module/system/foreign-library.scm
+++ b/module/system/foreign-library.scm
@@ -30,6 +30,7 @@
             ltdl-library-path
             guile-system-extensions-path
 
+            lib->cyg
             load-foreign-library
             foreign-library?
             foreign-library-pointer
@@ -152,13 +153,32 @@
        '())
    (guile-system-extensions-path)))
 
+(define (lib->cyg name)
+  "Convert a standard shared library name to a Cygwin shared library
+name."
+  (if (not name)
+      #f
+      (let ((start (1+ (or (string-index-right
+                            name
+                            (lambda (c) (or (char=? #\\ c) (char=? #\/ c))))
+                           -1))))
+        (cond
+         ((>= (+ 3 start) (string-length name))
+          name)
+         ((string= name "lib" start (+ start 3))
+          (string-append (substring name 0 start)
+                         "cyg"
+                         (substring name (+ start 3))))
+         (else
+          name)))))
+
 (define* (load-foreign-library #:optional filename #:key
                                (extensions system-library-extensions)
                                (search-ltdl-library-path? #t)
                                (search-path (default-search-path
                                               search-ltdl-library-path?))
                                (search-system-paths? #t)
-                               (lazy? #t) (global? #f))
+                               (lazy? #t) (global? #f) (rename-on-cygwin? #t))
   (define (error-not-found)
     (scm-error 'misc-error "load-foreign-library"
                "file: ~S, message: ~S"
@@ -168,6 +188,8 @@
     (logior (if lazy? RTLD_LAZY RTLD_NOW)
             (if global? RTLD_GLOBAL RTLD_LOCAL)))
   (define (dlopen* name) (dlopen name flags))
+  (if (and rename-on-cygwin? (string-contains %host-type "cygwin"))
+      (set! filename (lib->cyg filename)))
   (make-foreign-library
    filename
    (cond
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 966d214..fd0e276 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -417,3 +417,38 @@
       (equal? (parse-c-struct (make-c-struct layout data)
                               layout)
               data))))
+
+
+(with-test-prefix "lib->cyg"
+  (pass-if "name is #f"
+    (equal? #f (lib->cyg #f)))
+
+  (pass-if "name too short"
+    (string=? (lib->cyg "a") "a"))
+
+  (pass-if "name starts with 'lib'"
+    (string=? (lib->cyg "libfoo.dll") "cygfoo.dll"))
+
+  (pass-if "name contains 'lib'"
+    (string=? (lib->cyg "foolib.dll") "foolib.dll"))
+
+  (pass-if "name doesn't contain 'lib'"
+    (string=? (lib->cyg "foobar.dll") "foobar.dll"))
+
+  (pass-if "name in path too short"
+    (string=? (lib->cyg "/lib/a") "/lib/a"))
+
+  (pass-if "name in path starts with 'lib'"
+    (string=? (lib->cyg "/lib/libfoo.dll") "/lib/cygfoo.dll"))
+
+  (pass-if "name in path contains 'lib'"
+    (string=? (lib->cyg "/lib/foolib.dll") "/lib/foolib.dll"))
+
+  (pass-if "name in path doesn't contain 'lib'"
+    (string=? (lib->cyg "/lib/foobar.dll") "/lib/foobar.dll"))
+
+  (pass-if "name in windows path starts with 'lib'"
+    (string=? (lib->cyg "c:\\lib\\libfoo.dll") "c:\\lib\\cygfoo.dll"))
+
+  (pass-if "name in windows path doesn't contain 'lib'"
+    (string=? (lib->cyg "c:\\lib\\foobar.dll") "c:\\lib\\foobar.dll")))