suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/runtime-path: fix problems with 'so paths

Browse Source 
Search for versions within a library directory, instead of searching
across library directories for a version. That way, user-specific libraries
can take precedence generally.

Fix the construction of library names with versions to match `ffi-lib`.
Specifically, put the version after the suffix on platforms other than
Mac OS X.

Put the code to resolve 'so specs in one place.
This commit is contained in:
Matthew Flatt 2014-06-11 08:38:19 +01:00
parent 5b852cc4bd
commit 42e0d69746
4 changed files with 63 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -616,14 +616,13 @@ absolute path; it is an absolute path when searching in the
Racket-specific shared-object library directories (as determined by Racket-specific shared-object library directories (as determined by
@racket[get-lib-search-dirs]) locates the path. In this way, shared-object @racket[get-lib-search-dirs]) locates the path. In this way, shared-object
libraries that are installed specifically for Racket get carried libraries that are installed specifically for Racket get carried
along in distributions. The search tries using @racket[_str] directly, along in distributions. The search tries each directory in order;
within a directory, the search tries using @racket[_str] directly,
then it tries adding each version specified by @racket[_vers]---which defaults then it tries adding each version specified by @racket[_vers]---which defaults
to @racket['(#f)]---along with to @racket['(#f)]---along with
a platform-specific shared-library extension---as produced by a platform-specific shared-library extension---as produced by
@racket[(system-type 'so-suffix)]. A @racket[_vers] @racket[(system-type 'so-suffix)]. A @racket[_vers]
can be a string, or it can be a list of strings and @racket[#f]; in the can be a string, or it can be a list of strings and @racket[#f].
latter case, the versions are tried in order, where @racket[#f] omits
the addition of the version.
If @racket[expr] produces a list of the form @racket[(list 'module If @racket[expr] produces a list of the form @racket[(list 'module
_module-path _var-ref)] or @racket[(list 'so _str (list _module-path _var-ref)] or @racket[(list 'so _str (list

37
racket/collects/compiler/embed.rkt
View File

@ -11,6 +11,7 @@
setup/dirs setup/dirs
setup/variant setup/variant
file/ico file/ico
racket/private/so-search
"private/winsubsys.rkt" "private/winsubsys.rkt"
"private/macfw.rkt" "private/macfw.rkt"
"private/mach-o.rkt" "private/mach-o.rkt"
@ -989,16 +990,6 @@
full-path)))] full-path)))]
[else (mk-full path)])) [else (mk-full path)]))
(define (path-extra-suffix p sfx)
;; Library names may have a version number preceded
;; by a ".", which looks like a suffix, so add the
;; shared-library suffix using plain-old bytes append:
(let-values ([(base name dir?) (split-path p)])
(let ([name (bytes->path (bytes-append (path->bytes name) sfx))])
(if (path? base)
(build-path base name)
name))))
;; Write a module bundle that can be loaded with 'load' (do not embed it ;; Write a module bundle that can be loaded with 'load' (do not embed it
;; into an executable). The bundle is written to the current output port. ;; into an executable). The bundle is written to the current output port.
(define (do-write-module-bundle outp verbose? modules (define (do-write-module-bundle outp verbose? modules
@ -1137,31 +1128,7 @@
p))) p)))
(let ([p (cond (let ([p (cond
[(bytes? p) (bytes->path p)] [(bytes? p) (bytes->path p)]
[(and (list? p) [(so-spec? p) (so-find p)]
(or (= 2 (length p))
(= 3 (length p)))
(eq? 'so (car p)))
(ormap (lambda (vers)
(let ([f (if (eq? vers 'no-suffix)
(cadr p)
(path-extra-suffix
(cadr p)
(if (string? vers)
(bytes-append #"."
(string->bytes/utf-8 vers)
(system-type 'so-suffix))
(system-type 'so-suffix))))])
(ormap (lambda (p)
(let ([p (build-path p f)])
(and (or (file-exists? p)
(directory-exists? p))
p)))
(get-lib-search-dirs))))
(cons 'no-suffix
(if (= (length p) 3)
(let ([s (caddr p)])
(if (list? s) s (list s)))
'(#f))))]
[(and (list? p) [(and (list? p)
(eq? 'lib (car p))) (eq? 'lib (car p)))
(let ([p (if (null? (cddr p)) (let ([p (if (null? (cddr p))

55
racket/collects/racket/private/so-search.rkt Normal file
View File

@ -0,0 +1,55 @@
#lang racket/base
(require setup/dirs)
(provide so-spec? so-find)
(define (so-spec? p)
(and (list? p)
(or (= 2 (length p))
(= 3 (length p)))
(eq? 'so (car p))
(string? (cadr p))
(or (= 2 (length p))
(let ([s (caddr p)])
(define (vers? s) (or (not s) (string? s)))
(or (vers? s)
(and (list? s) (andmap vers? s)))))))
(define (path-extra-suffix p sfx)
;; Library names may have a version number preceded
;; by a ".", which looks like a suffix, so add the
;; shared-library suffix using plain-old bytes append:
(let-values ([(base name dir?) (split-path p)])
(let ([name (bytes->path (bytes-append (path->bytes name) sfx))])
(if (path? base)
(build-path base name)
name))))
(define (so-find p)
(let ([verss (cons 'no-suffix
(if (= (length p) 3)
(let ([s (caddr p)])
(if (list? s) s (list s)))
'(#f)))]
[suffix-before-version? (not (equal? (system-type 'so-suffix)
#".dylib"))])
(ormap (lambda (dir)
(ormap (lambda (vers)
(let ([f (if (eq? vers 'no-suffix)
(cadr p)
(path-extra-suffix (cadr p)
(if (string? vers)
(if suffix-before-version?
(bytes-append (system-type 'so-suffix)
#"."
(string->bytes/utf-8 vers))
(bytes-append #"."
(string->bytes/utf-8 vers)
(system-type 'so-suffix)))
(system-type 'so-suffix))))])
(let ([p (build-path dir f)])
(and (or (file-exists? p)
(directory-exists? p))
p))))
verss))
(get-lib-search-dirs))))

38
racket/collects/racket/runtime-path.rkt
View File

@ -3,7 +3,7 @@
;; Library for accessing paths relative to a source file at runtime ;; Library for accessing paths relative to a source file at runtime
(require racket/list (require racket/list
setup/dirs "private/so-search.rkt"
"private/this-expression-source-directory.rkt" "private/this-expression-source-directory.rkt"
(only-in "private/runtime-path-table.rkt" table) (only-in "private/runtime-path-table.rkt" table)
(for-syntax racket/base)) (for-syntax racket/base))
@ -95,41 +95,7 @@
(path->complete-path p base)] (path->complete-path p base)]
[(string? p) (string->path p)] [(string? p) (string->path p)]
[(path? p) p] [(path? p) p]
[(and (list? p) [(so-spec? p) (or (so-find p)
(or (= 2 (length p))
(= 3 (length p)))
(eq? 'so (car p))
(string? (cadr p))
(or (= 2 (length p))
(let ([s (caddr p)])
(define (vers? s) (or (not s) (string? s)))
(or (vers? s)
(and (list? s) (andmap vers? s))))))
(or (ormap (lambda (vers)
(define (path-extra-suffix p sfx)
(let-values ([(base name dir?) (split-path p)])
(let ([name (bytes->path (bytes-append (path->bytes name) sfx))])
(if (path? base)
(build-path base name)
name))))
(let ([f (if (eq? vers 'no-suffix)
(cadr p)
(path-extra-suffix (cadr p)
(if vers
(bytes-append #"."
(string->bytes/utf-8 vers)
(system-type 'so-suffix))
(system-type 'so-suffix))))])
(ormap (lambda (p)
(let ([p (build-path p f)])
(and (file-exists? p)
p)))
(get-lib-search-dirs))))
(cons 'no-suffix
(if (= (length p) 3)
(let ([s (caddr p)])
(if (list? s) s (list s)))
'(#f))))
(cadr p))] (cadr p))]
[(and (list? p) [(and (list? p)
((length p) . > . 1) ((length p) . > . 1)