GNU bug report logs - #64723
load-foreign-library has incomplete support for libtool-generated DLLs

Previous Next

To reply to this bug, email your comments to 64723 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Michael Gran <spk121 <at> yahoo.com>
To: bug-guile <at> gnu.org
Subject: load-foreign-library has incomplete support for libtool-generated DLLs
Date: Tue, 18 Jul 2023 23:47:10 -0700

The new non-libltdl foreign library loading algorithm from 3.0.6 fails
to cover common cases regarding how libtool names and installs DLL
files.  Notably, it fails to recognize when libtool has added the major
version number into the filename itself, such as libfoo-1.dll Also, it
does not search in binary directories and the PATH for DLL files, where
libtool is likely to install DLLs.

Also, just as it handles the libfoo.dll -> cygfoo.dll renaming for
cygwin, it should handle the libfoo.dll -> msys-foo.dll renaming for
MSYS

Message #8 received at 64723 <at> debbugs.gnu.org (full text, mbox):

From: Michael Gran <spk121 <at> yahoo.com>
To: 64723 <at> debbugs.gnu.org
Subject: [PATCH] Improve DLL search strategy for load-foreign-library
Date: Fri, 2 Jun 2023 16:28:55 -0700

The new non-libltdl foreign library loading algorithm from 3.0.6
fails to cover common cases regarding how libtool names and installs
DLL files.  Notably, it fails to recognize when libtool has added the
major version number into the filename itself, such as libfoo-1.dll
Also, it does not search in binary directories and the PATH for DLL
files, where libtool is likely to install DLLs.

This adds the option to search for dlls with major version numbers
in the filename, and modifies the search strategy for DLL-using
OSs to check bindir and PATH.

For MSYS, libraries are installed with the 'msys-' prefix. So this
modifies load-foreign-library to handle that prefix as well.
It changes the #:rename-on-cygwin? option to
#:host-type-rename?

Partially based on a patch by Hannes Müller.

* NEWS: updated
* doc/ref/api-foreign.text: document updates to load-foreign-library
  and system-dll-path
* module/system/foreign-library.scm (is-integer-string?): new utility function
  (dll-name-match?): new utility function
  (find-best-dll-from-matches): new utility function
  (dll-exists-with-version): new function that implements new dll search logic
  (file-exists-with-extension): add flag argument to allow new dll search
  (file-exists-in-path-with-extension): add flag argument to all new dll search
  (system-dll-path): new parameter
  (lib->msys): new helper function
  (load-foreign-library): add new optarg flag #:allow-dll-version-suffix?
    Pass new flag to library search functions.
    Implement new search strategy for #:search-system-paths? on DLL systems'
    replace #:rename-on-cygwin? with #:host-type-rename?
        Use that option to rename both MSYS and Cygwin libraries.
  (guile-system-extensions-path): prefer bindir to libdir on DLL systems
* test-suite/tests/foreign.test ("dll-name-match?"): new test category
  ("find-best-dll-from-matches"): new test category
  ("lib->msys"): new unit tests
---
 NEWS                              |  15 +++
 doc/ref/api-foreign.texi          | 135 ++++++++++++++++----------
 module/system/foreign-library.scm | 151 +++++++++++++++++++++++++++---
 test-suite/tests/foreign.test     | 114 +++++++++++++++++-----
 4 files changed, 326 insertions(+), 89 deletions(-)

diff --git a/NEWS b/NEWS
index 87aefb03f..d05649c42 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,21 @@ definitely unused---this is notably the case for modules that are only
 used at macro-expansion time, such as (srfi srfi-26).  In those cases,
 the compiler reports it as "possibly unused".
 
+** improve 'load-foreign-library' handling of DLLs
+
+The non-libltdl load-foreign-library introduced in 3.0.6 does not handle
+some common cases with libtool-generated DLLs.  It has been updated
+to search for DLLs that have a version number appended to the name
+by libtool, such as libfoo-1.dll.
+
+Also, it has been updated to do library renaming for MSYS.  On Cygwin,
+when the #:rename-on-cygwin? option is #t, it already had the capability
+to search for "libfoo" as "cygfoo.dll".  It has been updated to add the
+capability to search for "libfoo" as "msys-foo.dll" on MSYS.
+
+The load-foreign-library option #:rename-on-cygwin? has been changed to
+#:host-type-rename?, and handles both Cygwin and MSYS.
+
 * Bug fixes
 
 ** (ice-9 suspendable-ports) incorrect UTF-8 decoding
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index 540fbbaf5..d6ea72f7f 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.
-@c Copyright (C)  1996, 1997, 2000-2004, 2007-2014, 2016-2017, 2021
+@c Copyright (C)  1996, 1997, 2000-2004, 2007-2014, 2016-2017, 2021, 2023
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -83,19 +83,24 @@ implemented in the @code{(system foreign-library)} module.
        [#:extensions=system-library-extensions] @
        [#: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
-file.  Otherwise an error is thrown.
+       [#:search-system-paths?=#t] [#:lazy?=#t] [#:global=#f] @
+       [#:host-type-rename?=#t] [#:allow-dll-version-suffix?=#t]
 
-If @var{library} argument is omitted, it defaults to @code{#f}.  If
-@code{library} is false, the resulting foreign library gives access to
-all symbols available for dynamic linking in the main binary.
+This procedure finds the shared library denoted by @var{library} (a
+string) and dynamically links it into the running Guile application.  On
+success, the procedure returns a Scheme object suitable for representing
+the linked object file.  Otherwise an error is thrown.
+
+In the common usage, the @var{library} parameter is a filename
+with no path and with no filename extension, such as @code{.so},
+@code{.dylib} or @code{.dll}.  The procedure will search for the library
+in a set of standard locations using the common filename extensions for
+the OS.  The optional parameters can customize this behavior.
 
-It is not necessary to include any extension such as @code{.so} in
-@var{library}.  For each system, Guile has a default set of extensions
+When @var{library} has directory elements or a filename extension, a
+more targeted search is performed.
+
+For each system, Guile has a default set of extensions
 that it will try.  On GNU systems, the default extension set is just
 @code{.so}; on Windows, just @code{.dll}; and on Darwin (Mac OS), it is
 @code{.bundle}, @code{.so}, and @code{.dylib}.  Pass @code{#:extensions
@@ -113,42 +118,17 @@ environment variables:
 
 @table @env
 @item GUILE_EXTENSIONS_PATH
-This is the main environment variable for users to add directories
-containing Guile extensions.  The default value has no entries.  This
-environment variable was added in Guile 3.0.6.
+This is the environment variable for users to add directories containing
+Guile extensions to the search path.  The default value has no entries.
+This environment variable was added in Guile 3.0.6.
 @item LTDL_LIBRARY_PATH
-Before Guile 3.0.6, Guile loaded foreign libraries using @code{libltdl},
-the dynamic library loader provided by libtool.  This loader used
-@env{LTDL_LIBRARY_PATH}, and for backwards compatibility we still
-support that path.
-
-However, @code{libltdl} would not only open @code{.so} (or @code{.dll}
-and so on) files, but also the @code{.la} files created by libtool.  In
-installed libraries -- libraries that are in the target directories of
-@code{make install} -- @code{.la} files are never needed, to the extent
-that most GNU/Linux distributions remove them entirely.  It is
-sufficient to just load the @code{.so} (or @code{.dll} and so on) files,
-which are always located in the same directory as the @code{.la} files.
-
-But for uninstalled dynamic libraries, like those in a build tree, the
-situation is a bit of a mess.  If you have a project that uses libtool
-to build libraries -- which is the case for Guile, and for most projects
-using autotools -- and you build @file{foo.so} in directory @file{D},
-libtool will put @file{foo.la} in @file{D}, but @file{foo.so} gets put
-into @file{D/.libs}.
-
-Users were mostly oblivious to this situation, as @code{libltdl} had
-special logic to be able to read the @code{.la} file to know where to
-find the @code{.so}, even from an uninstalled build tree, preventing the
-existence of @file{.libs} from leaking out to the user.
+When @var{search-ltdl-library-path?} is true, this environment variable
+can also be used to add directories to the search path.  For each
+directory given in this environment variable, two directories are added
+to the search path: the given directory (for example, @code{D}) and a
+@code{.libs} subdirectory (@code{D/.libs}).
 
-We don't use libltdl now, essentially for flexibility and
-error-reporting reasons.  But, to keep this old use-case working, if
-@var{search-ltdl-library-path?} is true, we add each entry of
-@code{LTDL_LIBRARY_PATH} to the default extensions load path,
-additionally adding the @file{.libs} subdirextories for each entry, in
-case there are @file{.so} files there instead of alongside the
-@file{.la} files.
+For more information on the rationale, see the note below.
 @item GUILE_SYSTEM_EXTENSIONS_PATH
 The last path in Guile's search path belongs to Guile itself, and
 defaults to the libdir and the extensiondir, in that order.  For
@@ -157,6 +137,9 @@ example, if you install to @file{/opt/guile}, these would probably be
 @code{/opt/guile/lib/guile/@value{EFFECTIVE-VERSION}/extensions},
 respectively.  @xref{Parallel Installations}, for more details on
 @code{extensionsdir}.
+
+For DLL-using systems, it searches bindir rather than libdir, so
+@file{/opt/guile/bin} in this example.
 @end table
 
 Finally, if no library is found in the search path, and if @var{library}
@@ -165,8 +148,9 @@ is not absolute and does not include directory separators, and if
 own logic for where to locate @var{library}.  For example, on GNU, there
 will be a default set of paths (often @file{/usr/lib} and @file{/lib},
 though it depends on the system), and the @code{LD_LIBRARY_PATH}
-environment variable can add additional paths.  Other operating systems
-have other conventions.
+environment variable can add additional paths.  On DLL-using systems,
+the @env{PATH} is searched. Other operating systems have other
+conventions.
 
 Falling back to the operating system for search is usually not a great
 thing; it is a recipe for making programs that work on one machine but
@@ -179,10 +163,27 @@ 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
+If @var{host-type-rename?} is true (the default) library names may be
+modified based on the current @code{%host-type}.  On Cygwin hosts,
+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.
+Cygwin.  Similarly, for MSYS hosts, ``lib'' becomes ``msys-''.
+
+If @var{dll-version-suffix?} is true (the default), the search behavior
+is modified such that when searching for a DLL, it will also search for
+DLLs with version suffixes.  For example, a search for
+@file{libtiff.dll} will also allow @file{libtiff-1.dll}.  When the
+unversioned DLL is not found and multiple versioned DLLs exists, it will
+return the versioned DLL with the highest version. Note that when
+searching, directories take precedence. It does not return the highest
+versioned DLL among all search directories collectively; it returns the
+highest versioned in the first directory to have the DLL.
+
+If @var{library} argument is omitted, it defaults to @code{#f}.  If
+@code{library} is false, the resulting foreign library gives access to
+all symbols available for dynamic linking in the currently running
+executable.
+
 @end deffn
 
 The environment variables mentioned above are parsed when the
@@ -206,6 +207,38 @@ Return @code{#t} if @var{obj} is a foreign library, or @code{#f}
 otherwise.
 @end deffn
 
+Before Guile 3.0.6, Guile loaded foreign libraries using @code{libltdl},
+the dynamic library loader provided by libtool.  This loader used
+@env{LTDL_LIBRARY_PATH}, and for backwards compatibility we still
+support that path.
+
+However, @code{libltdl} would not only open @code{.so} (or @code{.dll}
+and so on) files, but also the @code{.la} files created by libtool.  In
+installed libraries -- libraries that are in the target directories of
+@code{make install} -- @code{.la} files are never needed, to the extent
+that most GNU/Linux distributions remove them entirely.  It is
+sufficient to just load the @code{.so} (or @code{.dll} and so on) files,
+which are always located in the same directory as the @code{.la} files.
+
+But for uninstalled dynamic libraries, like those in a build tree, the
+situation is a bit of a mess.  If you have a project that uses libtool
+to build libraries -- which is the case for Guile, and for most projects
+using autotools -- and you build @file{foo.so} in directory @file{D},
+libtool will put @file{foo.la} in @file{D}, but @file{foo.so} gets put
+into @file{D/.libs}.
+
+Users were mostly oblivious to this situation, as @code{libltdl} had
+special logic to be able to read the @code{.la} file to know where to
+find the @code{.so}, even from an uninstalled build tree, preventing the
+existence of @file{.libs} from leaking out to the user.
+
+We don't use libltdl now, essentially for flexibility and
+error-reporting reasons.  But, to keep this old use-case working, if
+@var{search-ltdl-library-path?} is true, we add each entry of
+@code{LTDL_LIBRARY_PATH} to the default extensions load path,
+additionally adding the @file{.libs} subdirextories for each entry, in
+case there are @file{.so} files there instead of alongside the
+@file{.la} files.
 
 @node Foreign Extensions
 @subsection Foreign Extensions
diff --git a/module/system/foreign-library.scm b/module/system/foreign-library.scm
index dc426385f..d0de93a2d 100644
--- a/module/system/foreign-library.scm
+++ b/module/system/foreign-library.scm
@@ -26,11 +26,13 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-9)
   #:use-module (system foreign)
+  #:use-module ((ice-9 ftw) #:select (scandir))
+  #:use-module ((srfi srfi-1) #:select (find))
   #:export (guile-extensions-path
             ltdl-library-path
             guile-system-extensions-path
 
-            lib->cyg
+            lib->cyg lib->msys
             load-foreign-library
             foreign-library?
             foreign-library-pointer
@@ -64,24 +66,96 @@
      (or (string-contains head ext)
          (has-extension? head exts)))))
 
-(define (file-exists-with-extension head exts)
-  (if (has-extension? head exts)
+(define (is-integer-string? str)
+  (and
+   (not (string-null? str))
+   (let ((n (string-length str)))
+     (let lp ((i 0))
+       (let ((c (string-ref str i)))
+         (if (or (char<? c #\0) (char>? c #\9))
+             #f
+             (if (= i (1- n))
+                 #t
+                 (lp (1+ i)))))))))
+
+(define (dll-name-match? src tgt)
+  (let ((srclen (string-length src))
+        (tgtlen (string-length tgt)))
+    (cond
+     ((or (< srclen tgtlen)
+          (< tgtlen 5)
+          (string-ci<> src ".dll" (- srclen 4))
+          (string-ci<> tgt ".dll" (- tgtlen 4))
+          (string-ci<> src tgt 0 (- tgtlen 4) 0 (- tgtlen 4)))
+      #f)
+     (else
+      (let ((mid (substring src (- tgtlen 4) (- srclen 4))))
+        (cond
+         ((or (string-null? mid)
+              (and (char=? (string-ref mid 0) #\-)
+                   (is-integer-string? (string-drop mid 1))))
+          #t)
+         (else
+          #f)))))))
+
+(define (find-best-dll-from-matches dllname lst)
+  ;; A DLL name without a version suffix is preferred,
+  ;; like libfoo.dll. But if we must have a version
+  ;; suffix as in libfoo-5.dll, we want the largest one.
+  (define (ver>? a b)
+    (cond
+     ((> (string-length a) (string-length b))
+      #t)
+     ((< (string-length a) (string-length b))
+      #f)
+     (else
+      (string-ci>? a b))))
+
+  (cond
+   ((null? lst)
+    #f)
+   ((= (length lst) 1)
+    (car lst))
+   (else
+    (or
+     (find (lambda (entry) (string-ci= entry dllname)) lst)
+     ;; The longest string that is alphabetically last
+     ;; is numerically the highest.
+     (car (sort lst ver>?))))))
+
+(define (dll-exists-with-version head)
+  ;; Searches for a DLL given a filepath, allowing
+  ;; for DLLs with version suffixes.
+  (let* ((fname (if (has-extension? head '(".dll"))
+                    head
+                    (string-append head ".dll")))
+         (dir (dirname fname))
+         (base (basename fname)))
+    (let ((matches (scandir dir (lambda (f) (dll-name-match? f base)))))
+      (if (or (not matches) (null? matches))
+          #f
+          (in-vicinity dir (find-best-dll-from-matches fname matches))))))
+
+(define (file-exists-with-extension head extensions versioned-dlls?)
+  (if (has-extension? head extensions)
       (and (file-exists? head) head)
-      (let lp ((exts exts))
+      (let lp ((exts extensions))
         (match exts
-          (() #f)
+          (() (if (and versioned-dlls? (member ".dll" extensions))
+                  (dll-exists-with-version head)
+                  #f))
           ((ext . exts)
            (let ((head (string-append head ext)))
              (if (file-exists? head)
                  head
                  (lp exts))))))))
 
-(define (file-exists-in-path-with-extension basename path exts)
+(define (file-exists-in-path-with-extension basename path exts versioned-dlls?)
   (match path
     (() #f)
     ((dir . path)
-     (or (file-exists-with-extension (in-vicinity dir basename) exts)
-         (file-exists-in-path-with-extension basename path exts)))))
+     (or (file-exists-with-extension (in-vicinity dir basename) exts versioned-dlls?)
+         (file-exists-in-path-with-extension basename path exts versioned-dlls?)))))
 
 (define path-separator
   (case (system-file-name-convention)
@@ -107,9 +181,17 @@
 (define guile-system-extensions-path
   (make-parameter
    (or (parse-path "GUILE_SYSTEM_EXTENSIONS_PATH")
-       (list (assq-ref %guile-build-info 'libdir)
+       (list (if (or (string-contains %host-type "cygwin")
+                     (string-contains %host-type "mingw")
+                     (string-contains %host-type "msys"))
+                 (assq-ref %guile-build-info 'bindir)
+                 (assq-ref %guile-build-info 'libdir))
              (assq-ref %guile-build-info 'extensiondir)))))
 
+(define system-dll-path
+  (make-parameter
+   (or (parse-path "PATH") '())))
+
 ;; There are a few messy situations here related to libtool.
 ;;
 ;; Guile used to use libltdl, the dynamic library loader provided by
@@ -145,6 +227,7 @@
      (cons* dir (in-vicinity dir ".libs")
             (augment-ltdl-library-path path)))))
 
+
 (define (default-search-path search-ltdl-library-path?)
   (append
    (guile-extensions-path)
@@ -172,13 +255,33 @@ name."
          (else
           name)))))
 
+(define (lib->msys name)
+  "Convert a standard shared library name to a MSYS 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)
+                         "msys-"
+                         (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) (rename-on-cygwin? #t))
+                               (lazy? #t) (global? #f) (host-type-rename? #t)
+                               (allow-dll-version-suffix? #t))
   (define (error-not-found)
     (scm-error 'misc-error "load-foreign-library"
                "file: ~S, message: ~S"
@@ -187,9 +290,18 @@ name."
   (define flags
     (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"))
+  (define (dlopen* name)
+    (dlopen name flags))
+  (define (file-exists-with-ext filename extensions)
+    (file-exists-with-extension filename extensions allow-dll-version-suffix?))
+  (define (file-exists-in-path-with-ext filename search-path extensions)
+    (file-exists-in-path-with-extension
+     filename search-path extensions allow-dll-version-suffix?))
+  (when host-type-rename?
+    (when (string-contains %host-type "cygwin")
       (set! filename (lib->cyg filename)))
+    (when (string-contains %host-type "msys")
+      (set! filename (lib->msys filename))))
   (make-foreign-library
    filename
    (cond
@@ -199,17 +311,26 @@ name."
     ((or (absolute-file-name? filename)
          (string-any file-name-separator? filename))
      (cond
-      ((or (file-exists-with-extension filename extensions)
+      ((or (file-exists-with-ext filename extensions)
            (and search-ltdl-library-path?
-                (file-exists-with-extension
+                (file-exists-with-ext
                  (in-vicinity (in-vicinity (dirname filename) ".libs")
                               (basename filename))
                  extensions)))
        => dlopen*)
       (else
        (error-not-found))))
-    ((file-exists-in-path-with-extension filename search-path extensions)
+    ((file-exists-in-path-with-ext filename search-path extensions)
      => dlopen*)
+    ((and search-system-paths?
+          (or (string-contains %host-type "cygwin")
+              (string-contains %host-type "mingw")
+              (string-contains %host-type "msys")))
+     (let ((fullname (file-exists-in-path-with-ext filename (system-dll-path) '(".dll"))))
+       (if fullname
+           (dlopen* fullname)
+           (error-not-found))))
+
     (search-system-paths?
      (if (or (null? extensions) (has-extension? filename extensions))
          (dlopen* filename)
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 28d7b5df8..2a6e0e26f 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -426,36 +426,104 @@
                                      layout))))))
 
 
-(with-test-prefix "lib->cyg"
-  (pass-if "name is #f"
-    (equal? #f (lib->cyg #f)))
+(with-test-prefix "host-type-rename?"
+  (with-test-prefix "cyg"
+    (pass-if "name is #f"
+      (equal? #f (lib->cyg #f)))
 
-  (pass-if "name too short"
-    (string=? (lib->cyg "a") "a"))
+    (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 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 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 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 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 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 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 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 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")))
+    (pass-if "name in windows path doesn't contain 'lib'"
+      (string=? (lib->cyg "c:\\lib\\foobar.dll") "c:\\lib\\foobar.dll")))
+
+  (with-test-prefix "msys"
+
+    (pass-if "name is #f"
+      (equal? #f (lib->msys #f)))
+
+    (pass-if "name too short"
+      (string=? (lib->msys "a") "a"))
+
+    (pass-if "name starts with 'lib'"
+      (string=? (lib->msys "libfoo.dll") "msys-foo.dll"))
+
+    (pass-if "name contains 'lib'"
+      (string=? (lib->msys "foolib.dll") "foolib.dll"))
+
+    (pass-if "name doesn't contain 'lib'"
+      (string=? (lib->msys "foobar.dll") "foobar.dll"))
+
+    (pass-if "name in path too short"
+      (string=? (lib->msys "/lib/a") "/lib/a"))
+
+    (pass-if "name in path starts with 'lib'"
+      (string=? (lib->msys "/lib/libfoo.dll") "/lib/msys-foo.dll"))
+
+    (pass-if "name in path contains 'lib'"
+      (string=? (lib->msys "/lib/foolib.dll") "/lib/foolib.dll"))
+
+    (pass-if "name in path doesn't contain 'lib'"
+      (string=? (lib->msys "/lib/foobar.dll") "/lib/foobar.dll"))
+
+    (pass-if "name in windows path starts with 'lib'"
+      (string=? (lib->msys "c:\\lib\\libfoo.dll") "c:\\lib\\msys-foo.dll"))
+
+    (pass-if "name in windows path doesn't contain 'lib'"
+      (string=? (lib->msys "c:\\lib\\foobar.dll") "c:\\lib\\foobar.dll"))))
+
+
+
+(with-test-prefix "dll-name-match?"
+  (let ((dll-name-match? (@@ (system foreign-library) dll-name-match?)))
+    (pass-if "libfoo.dll == libfoo.dll"
+      (dll-name-match? "libfoo.dll" "libfoo.dll"))
+    (pass-if "libfoo-1.dll == libfoo.dll"
+      (dll-name-match? "libfoo-1.dll" "libfoo.dll"))
+    (pass-if "libfoo-10.dll == libfoo.dll"
+      (dll-name-match? "libfoo-10.dll" "libfoo.dll"))
+    (pass-if "libfoo-.dll != libfoo.dll"
+      (not (dll-name-match? "libfoo-.dll" "libfoo.dll")))
+    (pass-if "libfoo-a.dll != libfoo.dll"
+      (not (dll-name-match? "libfoo-a.dll" "libfoo.dll")))
+    (pass-if "libfoo-1a.dll != libfoo.dll"
+      (not (dll-name-match? "libfoo-a.dll" "libfoo.dll")))))
+
+(with-test-prefix "find-best-dll-from-matches"
+  (let ((find-best? (@@ (system foreign-library) find-best-dll-from-matches)))
+    (pass-if-equal "prefer unversioned name"
+        "libfoo.dll"
+      (find-best? "libfoo.dll" '("libfoo.dll" "libfoo-1.dll")))
+    (pass-if-equal "allow versioned name"
+        "libfoo-1.dll"
+      (find-best? "libfoo.dll" '("libfoo-1.dll")))
+    (pass-if-equal "larger is better"
+        "libfoo-2.dll"
+      (find-best? "libfoo.dll" '("libfoo-1.dll" "libfoo-2.dll")))
+    (pass-if-equal "multiple digits ok"
+        "libfoo-123.dll"
+      (find-best? "libfoo.dll" '("libfoo-1.dll" "libfoo-123.dll")))))
-- 
2.41.0

Message #11 received at 64723 <at> debbugs.gnu.org (full text, mbox):

From: Mike Gran <spk121 <at> yahoo.com>
To: "64723 <at> debbugs.gnu.org" <64723 <at> debbugs.gnu.org>
Subject: Re: [PATCH] Improve DLL search strategy for load-foreign-library
Date: Thu, 7 Sep 2023 15:33:55 +0000 (UTC)

> The new non-libltdl foreign library loading algorithm from 3.0.6
> fails to cover common cases regarding how libtool names and installs
> DLL files.  Notably, it fails to recognize when libtool has added the
> major version number into the filename itself, such as libfoo-1.dll
> Also, it does not search in binary directories and the PATH for DLL
> files, where libtool is likely to install DLLs.

Hi All-

This is the first of a dozen patches to make Win32 minimally viable
again. This patch specifically removes a regression introduced in 3.0.6
described above.

If I hear no objection, I'm going to rebase and push
in a week or two.

There are only a couple things in here to which one might find
interesting (aka objectionable).  One is the renaming of the "#:rename-on-cygwin?
option of `load-foreign-library` to "#:host-type-rename?" to
indicate that it handles both msys and cygwin libraries.

The other is the code itself, which could be a lot shorter
if I pulled in other modules. I'm
never comfortable pulling in modules into other modules in
Guile's core itself, for fear of creating spaghetti.  As a consequence,
some of the string handling is comically verbose.

Regards,
Mike Gran

Message #20 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Janneke Nieuwenhuizen <janneke <at> gnu.org>
To: Mike Gran via "Bug reports for GUILE, GNU's Ubiquitous Extension
 Language" <bug-guile <at> gnu.org>
Cc: "64723 <at> debbugs.gnu.org" <64723 <at> debbugs.gnu.org>,
 Mike Gran <spk121 <at> yahoo.com>
Subject: Re: bug#64723: [PATCH] Improve DLL search strategy for
 load-foreign-library
Date: Sat, 09 Sep 2023 07:44:46 +0200

Mike Gran via Bug reports for GUILE, GNU's Ubiquitous Extension Language writes:

Hello Mike,

>> The new non-libltdl foreign library loading algorithm from 3.0.6
>> fails to cover common cases regarding how libtool names and installs
>> DLL files.  Notably, it fails to recognize when libtool has added the
>> major version number into the filename itself, such as libfoo-1.dll
>> Also, it does not search in binary directories and the PATH for DLL
>> files, where libtool is likely to install DLLs.
>
> Hi All-
>
> This is the first of a dozen patches to make Win32 minimally viable
> again. This patch specifically removes a regression introduced in 3.0.6
> described above.
>
> If I hear no objection, I'm going to rebase and push
> in a week or two.

Very much appreciated!

Greetings,
Janneke

-- 
Janneke Nieuwenhuizen <janneke <at> gnu.org>  | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.