add #:get-lib-dirs and #:fail args to `ffi-lib'
Not currently used, because an experiment that used the additions was abandoned, but another use in the future seems likely.
This commit is contained in:
parent
2262cd4424
commit
f38e57ff68
|
@ -91,61 +91,62 @@
|
|||
|
||||
(provide (protect-out (rename-out [get-ffi-lib ffi-lib]))
|
||||
ffi-lib? ffi-lib-name)
|
||||
(define get-ffi-lib
|
||||
(case-lambda
|
||||
[(name) (get-ffi-lib name "")]
|
||||
[(name version/s)
|
||||
(cond
|
||||
[(not name) (ffi-lib name)] ; #f => NULL => open this executable
|
||||
[(not (or (string? name) (path? name)))
|
||||
(raise-type-error 'ffi-lib "library-name" name)]
|
||||
[else
|
||||
;; A possible way that this might be misleading: say that there is a
|
||||
;; "foo.so" file in the current directory, which refers to some
|
||||
;; undefined symbol, trying to use this function with "foo.so" will try
|
||||
;; a dlopen with "foo.so" which isn't found, then it tries a dlopen with
|
||||
;; "/<curpath>/foo.so" which fails because of the undefined symbol, and
|
||||
;; since all fails, it will use (ffi-lib "foo.so") to raise the original
|
||||
;; file-not-found error. This is because the dlopen doesn't provide a
|
||||
;; way to distinguish different errors (only dlerror, but that's
|
||||
;; unreliable).
|
||||
(let* ([versions (if (list? version/s) version/s (list version/s))]
|
||||
[versions (map (lambda (v)
|
||||
(if (or (not v) (zero? (string-length v)))
|
||||
"" (string-append "." v)))
|
||||
versions)]
|
||||
[fullpath (lambda (p) (path->complete-path (cleanse-path p)))]
|
||||
[absolute? (absolute-path? name)]
|
||||
[name0 (path->string (cleanse-path name))] ; orig name
|
||||
[names (map (if (regexp-match lib-suffix-re name0) ; name+suffix
|
||||
(lambda (v) (string-append name0 v))
|
||||
(lambda (v)
|
||||
(if suffix-before-version?
|
||||
(string-append name0 "." lib-suffix v)
|
||||
(string-append name0 v "." lib-suffix))))
|
||||
versions)]
|
||||
[ffi-lib* (lambda (name) (ffi-lib name #t))])
|
||||
(or ;; try to look in our library paths first
|
||||
(and (not absolute?)
|
||||
(ormap (lambda (dir)
|
||||
;; try good names first, then original
|
||||
(or (ormap (lambda (name)
|
||||
(ffi-lib* (build-path dir name)))
|
||||
names)
|
||||
(ffi-lib* (build-path dir name0))))
|
||||
(get-lib-search-dirs)))
|
||||
;; try a system search
|
||||
(ormap ffi-lib* names) ; try good names first
|
||||
(ffi-lib* name0) ; try original
|
||||
(ormap (lambda (name) ; try relative paths
|
||||
(and (file-exists? name) (ffi-lib* (fullpath name))))
|
||||
names)
|
||||
(and (file-exists? name0) ; relative with original
|
||||
(ffi-lib* (fullpath name0)))
|
||||
;; give up: call ffi-lib so it will raise an error
|
||||
(if (pair? names)
|
||||
(ffi-lib (car names))
|
||||
(ffi-lib name0))))])]))
|
||||
(define (get-ffi-lib name [version/s ""]
|
||||
#:fail [fail #f]
|
||||
#:get-lib-dirs [get-lib-dirs get-lib-search-dirs])
|
||||
(cond
|
||||
[(not name) (ffi-lib name)] ; #f => NULL => open this executable
|
||||
[(not (or (string? name) (path? name)))
|
||||
(raise-type-error 'ffi-lib "library-name" name)]
|
||||
[else
|
||||
;; A possible way that this might be misleading: say that there is a
|
||||
;; "foo.so" file in the current directory, which refers to some
|
||||
;; undefined symbol, trying to use this function with "foo.so" will try
|
||||
;; a dlopen with "foo.so" which isn't found, then it tries a dlopen with
|
||||
;; "/<curpath>/foo.so" which fails because of the undefined symbol, and
|
||||
;; since all fails, it will use (ffi-lib "foo.so") to raise the original
|
||||
;; file-not-found error. This is because the dlopen doesn't provide a
|
||||
;; way to distinguish different errors (only dlerror, but that's
|
||||
;; unreliable).
|
||||
(let* ([versions (if (list? version/s) version/s (list version/s))]
|
||||
[versions (map (lambda (v)
|
||||
(if (or (not v) (zero? (string-length v)))
|
||||
"" (string-append "." v)))
|
||||
versions)]
|
||||
[fullpath (lambda (p) (path->complete-path (cleanse-path p)))]
|
||||
[absolute? (absolute-path? name)]
|
||||
[name0 (path->string (cleanse-path name))] ; orig name
|
||||
[names (map (if (regexp-match lib-suffix-re name0) ; name+suffix
|
||||
(lambda (v) (string-append name0 v))
|
||||
(lambda (v)
|
||||
(if suffix-before-version?
|
||||
(string-append name0 "." lib-suffix v)
|
||||
(string-append name0 v "." lib-suffix))))
|
||||
versions)]
|
||||
[ffi-lib* (lambda (name) (ffi-lib name #t))])
|
||||
(or ;; try to look in our library paths first
|
||||
(and (not absolute?)
|
||||
(ormap (lambda (dir)
|
||||
;; try good names first, then original
|
||||
(or (ormap (lambda (name)
|
||||
(ffi-lib* (build-path dir name)))
|
||||
names)
|
||||
(ffi-lib* (build-path dir name0))))
|
||||
(get-lib-dirs)))
|
||||
;; try a system search
|
||||
(ormap ffi-lib* names) ; try good names first
|
||||
(ffi-lib* name0) ; try original
|
||||
(ormap (lambda (name) ; try relative paths
|
||||
(and (file-exists? name) (ffi-lib* (fullpath name))))
|
||||
names)
|
||||
(and (file-exists? name0) ; relative with original
|
||||
(ffi-lib* (fullpath name0)))
|
||||
;; give up: by default, call ffi-lib so it will raise an error
|
||||
(if fail
|
||||
(fail)
|
||||
(if (pair? names)
|
||||
(ffi-lib (car names))
|
||||
(ffi-lib name0)))))]))
|
||||
|
||||
(define (get-ffi-lib-internal x)
|
||||
(if (ffi-lib? x) x (get-ffi-lib x)))
|
||||
|
|
|
@ -10,14 +10,18 @@ libraries}} or @defterm{@as-index{dynamically loaded libraries}}). The
|
|||
|
||||
@defproc[(ffi-lib? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] is the result of @racket[ffi-lib],
|
||||
Returns @racket[#t] if @racket[v] is a @deftech{foreign-library value},
|
||||
@racket[#f] otherwise.}
|
||||
|
||||
|
||||
@defproc[(ffi-lib [path (or/c path-string? #f)]
|
||||
[version (or/c string? (listof (or/c string? #f)) #f) #f]) any]{
|
||||
[version (or/c string? (listof (or/c string? #f)) #f) #f]
|
||||
[#:get-lib-dirs get-lib-dirs (-> (listof path?)) get-lib-search-dirs]
|
||||
[#:fail fail (or/c #f (-> any)) #f])
|
||||
any]{
|
||||
|
||||
Returns a foreign-library value. Normally,
|
||||
Returns a @tech{foreign-library value} or the result of @racket[fail].
|
||||
Normally,
|
||||
|
||||
@itemlist[
|
||||
|
||||
|
@ -49,7 +53,7 @@ process:
|
|||
@itemlist[
|
||||
|
||||
@item{If @racket[path] is not an absolute path, look in each
|
||||
directory reported by @racket[get-lib-search-dirs]. In each
|
||||
directory reported by @racket[get-lib-dirs]. In each
|
||||
directory, try @racket[path] with the first version in
|
||||
@racket[version], adding a suitable suffix if @racket[path]
|
||||
does not already end in the suffix, then try the second version
|
||||
|
@ -74,7 +78,9 @@ process:
|
|||
|
||||
]
|
||||
|
||||
If none of the paths succeed, the error is reported from trying the
|
||||
If none of the paths succeed and @racket[fail] is a function, then
|
||||
@racket[fail] is called in tail position. If @racket[fail] is
|
||||
@racket[#f], an error is reported from trying the
|
||||
first path from the second bullet above or (if @racket[version] is an
|
||||
empty list) from the third bullet above. A library file may exist but
|
||||
fail to load for some reason; the eventual error message will
|
||||
|
@ -103,9 +109,9 @@ corresponding library.}
|
|||
any]{
|
||||
|
||||
Looks for the given object name @racket[objname] in the given
|
||||
@racket[lib] library. If @racket[lib] is not a foreign-library value
|
||||
produced by @racket[ffi-lib], it is converted to one by calling
|
||||
@racket[ffi-lib]. If @racket[objname] is found in @racket[lib], it is
|
||||
@racket[lib] library. If @racket[lib] is not a @tech{foreign-library value}
|
||||
it is converted to one by calling @racket[ffi-lib]. If @racket[objname]
|
||||
is found in @racket[lib], it is
|
||||
converted to Racket using the given @racket[type]. Types are described
|
||||
in @secref["types"]; in particular the @racket[get-ffi-obj] procedure
|
||||
is most often used with function types created with @racket[_fun].
|
||||
|
|
Loading…
Reference in New Issue
Block a user