diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index e4c068420..2bd460a88 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 eaeb26700..d53e293ef 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 966d214a0..fd0e276e2 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")))