diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl index 20fc814b1c..bd9555bbb6 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -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[get-lib-search-dirs]) locates the path. In this way, shared-object 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 to @racket['(#f)]---along with a platform-specific shared-library extension---as produced by @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 -latter case, the versions are tried in order, where @racket[#f] omits -the addition of the version. +can be a string, or it can be a list of strings and @racket[#f]. If @racket[expr] produces a list of the form @racket[(list 'module _module-path _var-ref)] or @racket[(list 'so _str (list diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index c646ecc2be..686f7909e7 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -11,6 +11,7 @@ setup/dirs setup/variant file/ico + racket/private/so-search "private/winsubsys.rkt" "private/macfw.rkt" "private/mach-o.rkt" @@ -989,16 +990,6 @@ 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 ;; into an executable). The bundle is written to the current output port. (define (do-write-module-bundle outp verbose? modules @@ -1137,31 +1128,7 @@ p))) (let ([p (cond [(bytes? p) (bytes->path p)] - [(and (list? 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))))] + [(so-spec? p) (so-find p)] [(and (list? p) (eq? 'lib (car p))) (let ([p (if (null? (cddr p)) diff --git a/racket/collects/racket/private/so-search.rkt b/racket/collects/racket/private/so-search.rkt new file mode 100644 index 0000000000..46b80f0ecd --- /dev/null +++ b/racket/collects/racket/private/so-search.rkt @@ -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)))) diff --git a/racket/collects/racket/runtime-path.rkt b/racket/collects/racket/runtime-path.rkt index a69f330b5e..5eaa5336b8 100644 --- a/racket/collects/racket/runtime-path.rkt +++ b/racket/collects/racket/runtime-path.rkt @@ -3,7 +3,7 @@ ;; Library for accessing paths relative to a source file at runtime (require racket/list - setup/dirs + "private/so-search.rkt" "private/this-expression-source-directory.rkt" (only-in "private/runtime-path-table.rkt" table) (for-syntax racket/base)) @@ -95,42 +95,8 @@ (path->complete-path p base)] [(string? p) (string->path p)] [(path? p) 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)))))) - (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))] + [(so-spec? p) (or (so-find p) + (cadr p))] [(and (list? p) ((length p) . > . 1) (eq? 'lib (car p))