1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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
This commit is contained in:
Mike Gran 2021-03-13 09:09:30 -08:00
parent db9725fd02
commit 5a1e78a278
3 changed files with 64 additions and 1 deletions

View file

@ -84,6 +84,7 @@ implemented in the @code{(system foreign-library)} module.
[#:search-ltdl-library-path?=#t] @ [#:search-ltdl-library-path?=#t] @
[#:search-path=search-path] @ [#:search-path=search-path] @
[#:search-system-paths?=#t] [#:lazy?=#t] [#:global=#f] [#: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}) Find the shared library denoted by @var{library} (a string or @code{#f})
and link it into the running Guile application. When everything works and link it into the running Guile application. When everything works
out, return a Scheme object suitable for representing the linked object 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 used. If @var{global?} is true, symbols defined by the loaded library
will be available when other modules need to resolve symbols; the will be available when other modules need to resolve symbols; the
default is @code{#f}, which keeps symbols local. 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 @end deffn
The environment variables mentioned above are parsed when the The environment variables mentioned above are parsed when the

View file

@ -30,6 +30,7 @@
ltdl-library-path ltdl-library-path
guile-system-extensions-path guile-system-extensions-path
lib->cyg
load-foreign-library load-foreign-library
foreign-library? foreign-library?
foreign-library-pointer foreign-library-pointer
@ -152,13 +153,32 @@
'()) '())
(guile-system-extensions-path))) (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 (define* (load-foreign-library #:optional filename #:key
(extensions system-library-extensions) (extensions system-library-extensions)
(search-ltdl-library-path? #t) (search-ltdl-library-path? #t)
(search-path (default-search-path (search-path (default-search-path
search-ltdl-library-path?)) search-ltdl-library-path?))
(search-system-paths? #t) (search-system-paths? #t)
(lazy? #t) (global? #f)) (lazy? #t) (global? #f) (rename-on-cygwin? #t))
(define (error-not-found) (define (error-not-found)
(scm-error 'misc-error "load-foreign-library" (scm-error 'misc-error "load-foreign-library"
"file: ~S, message: ~S" "file: ~S, message: ~S"
@ -168,6 +188,8 @@
(logior (if lazy? RTLD_LAZY RTLD_NOW) (logior (if lazy? RTLD_LAZY RTLD_NOW)
(if global? RTLD_GLOBAL RTLD_LOCAL))) (if global? RTLD_GLOBAL RTLD_LOCAL)))
(define (dlopen* name) (dlopen name flags)) (define (dlopen* name) (dlopen name flags))
(if (and rename-on-cygwin? (string-contains %host-type "cygwin"))
(set! filename (lib->cyg filename)))
(make-foreign-library (make-foreign-library
filename filename
(cond (cond

View file

@ -417,3 +417,38 @@
(equal? (parse-c-struct (make-c-struct layout data) (equal? (parse-c-struct (make-c-struct layout data)
layout) layout)
data)))) 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")))