From f38e57ff685c9e318636a90fcdc160a890de4e66 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 4 Oct 2011 20:17:54 -0600 Subject: [PATCH] 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. --- collects/ffi/unsafe.rkt | 111 ++++++++++++------------ collects/scribblings/foreign/libs.scrbl | 22 +++-- 2 files changed, 70 insertions(+), 63 deletions(-) diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt index 4d16620752..5852cf7c8f 100644 --- a/collects/ffi/unsafe.rkt +++ b/collects/ffi/unsafe.rkt @@ -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 - ;; "//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 + ;; "//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))) diff --git a/collects/scribblings/foreign/libs.scrbl b/collects/scribblings/foreign/libs.scrbl index 85f2ade530..266d23bb33 100644 --- a/collects/scribblings/foreign/libs.scrbl +++ b/collects/scribblings/foreign/libs.scrbl @@ -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].