mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 11:10:32 +02:00
Improve DLL search strategy for load-foreign-library
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? to better reflect that is works on both Cygwin and MSYS. Partially based on a patch by Hannes Müller. * NEWS: updated * doc/ref/api-foreign.texi: 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
This commit is contained in:
parent
c9a19a03f8
commit
7b41294049
4 changed files with 346 additions and 109 deletions
15
NEWS
15
NEWS
|
@ -261,6 +261,21 @@ binary-port) used to be implemented in C, making it non-suspendable--a
|
|||
bummer for programs using suspendable ports and Fibers. It has been
|
||||
rewritten in Scheme, addressing this limitation.
|
||||
|
||||
** 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.
|
||||
|
||||
* Performance improvements
|
||||
|
||||
** Better compilation of calls to procedures with keyword arguments
|
||||
|
|
|
@ -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.
|
||||
|
||||
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
|
||||
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.
|
||||
|
||||
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,10 +118,95 @@ 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
|
||||
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}).
|
||||
|
||||
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
|
||||
example, if you install to @file{/opt/guile}, these would probably be
|
||||
@file{/opt/guile/lib} and
|
||||
@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}
|
||||
is not absolute and does not include directory separators, and if
|
||||
@var{search-system-paths?} is true, the operating system may have its
|
||||
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. 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
|
||||
not on others. Still, when wrapping system libraries, it can be the
|
||||
only way to get things working at all.
|
||||
|
||||
If @var{lazy?} is true (the default), Guile will request the operating
|
||||
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{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. 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
|
||||
foreign-library module is first loaded and bound to parameters. Null
|
||||
path components, for example the three components of
|
||||
@env{GUILE_SYSTEM_EXTENSIONS_PATH="::"}, are ignored.
|
||||
|
||||
@deffn {Scheme Parameter} guile-extensions-path
|
||||
@deffnx {Scheme Parameter} ltdl-library-path
|
||||
@deffnx {Scheme Parameter} guile-system-extensions-path
|
||||
Parameters whose initial values are taken from
|
||||
@env{GUILE_EXTENSIONS_PATH}, @env{LTDL_LIBRARY_PATH}, and
|
||||
@env{GUILE_SYSTEM_EXTENSIONS_PATH}, respectively. @xref{Parameters}.
|
||||
The current values of these parameters are used when building the search
|
||||
path when @code{load-foreign-library} is called, unless the caller
|
||||
explicitly passes a @code{#:search-path} argument.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} foreign-library? obj
|
||||
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
|
||||
|
@ -149,63 +239,6 @@ error-reporting reasons. But, to keep this old use-case working, if
|
|||
additionally adding the @file{.libs} subdirectories for each entry, in
|
||||
case there are @file{.so} files there instead of alongside the
|
||||
@file{.la} files.
|
||||
@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
|
||||
example, if you install to @file{/opt/guile}, these would probably be
|
||||
@file{/opt/guile/lib} and
|
||||
@code{/opt/guile/lib/guile/@value{EFFECTIVE-VERSION}/extensions},
|
||||
respectively. @xref{Parallel Installations}, for more details on
|
||||
@code{extensionsdir}.
|
||||
@end table
|
||||
|
||||
Finally, if no library is found in the search path, and if @var{library}
|
||||
is not absolute and does not include directory separators, and if
|
||||
@var{search-system-paths?} is true, the operating system may have its
|
||||
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.
|
||||
|
||||
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
|
||||
not on others. Still, when wrapping system libraries, it can be the
|
||||
only way to get things working at all.
|
||||
|
||||
If @var{lazy?} is true (the default), Guile will request the operating
|
||||
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
|
||||
foreign-library module is first loaded and bound to parameters. Null
|
||||
path components, for example the three components of
|
||||
@env{GUILE_SYSTEM_EXTENSIONS_PATH="::"}, are ignored.
|
||||
|
||||
@deffn {Scheme Parameter} guile-extensions-path
|
||||
@deffnx {Scheme Parameter} ltdl-library-path
|
||||
@deffnx {Scheme Parameter} guile-system-extensions-path
|
||||
Parameters whose initial values are taken from
|
||||
@env{GUILE_EXTENSIONS_PATH}, @env{LTDL_LIBRARY_PATH}, and
|
||||
@env{GUILE_SYSTEM_EXTENSIONS_PATH}, respectively. @xref{Parameters}.
|
||||
The current values of these parameters are used when building the search
|
||||
path when @code{load-foreign-library} is called, unless the caller
|
||||
explicitly passes a @code{#:search-path} argument.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} foreign-library? obj
|
||||
Return @code{#t} if @var{obj} is a foreign library, or @code{#f}
|
||||
otherwise.
|
||||
@end deffn
|
||||
|
||||
|
||||
@node Foreign Extensions
|
||||
@subsection Foreign Extensions
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -425,36 +425,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")))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue