From 44c29dfb6ccee46d2d3001f1ce9770d0cf2c39f4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Nov 2013 07:26:13 -0700 Subject: [PATCH] define-runtime-path: add support for version search to 'so form Merge to v6.0 (cherry picked from commit c7d4b7d388c19718efdf3f9cfa5215d7a19a5e3f) --- .../scribblings/reference/filesystem.scrbl | 21 ++++++--- racket/collects/compiler/embed.rkt | 27 ++++++++---- racket/collects/db/private/sqlite3/ffi.rkt | 2 +- racket/collects/racket/runtime-path.rkt | 43 +++++++++++++++---- 4 files changed, 68 insertions(+), 25 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl index c4a5f81012..e11b4f8bf1 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -568,7 +568,7 @@ Uses @racket[expr] as both a compile-time (i.e., @tech{phase} 1) expression and a run-time (i.e., @tech{phase} 0) expression. In either context, @racket[expr] should produce a path, a string that represents a path, a list of the form @racket[(list 'lib _str ...+)], or a list -of the form @racket[(list 'so _str)]. +of the form @racket[(list 'so _str)] or @racket[(list 'so _str _vers)]. For run time, @racket[id] is bound to a path that is based on the result of @racket[expr]. The path is normally computed by taking a @@ -588,18 +588,25 @@ If @racket[expr] produces a list of the form @racket[(list 'lib _str refers to a collection-based file similar to using the value as a @tech{module path}. -If @racket[expr] produces a list of the form @racket[(list 'so _str)], +If @racket[expr] produces a list of the form @racket[(list 'so _str)] +or @racket[(list 'so _str _vers)], the value bound to @racket[id] can be either @racket[_str] or an -absolute path; it is an absolute path when adding the -platform-specific shared-library extension --- as produced by -@racket[(system-type 'so-suffix)] --- and then searching in the +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. +along in distributions. 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. If @racket[expr] produces a list of the form @racket[(list 'module -_module-path _var-ref)], the value bound to @racket[id] is a +_module-path _var-ref)] or @racket[(list 'so _str (list +_str-or-false ...))], the value bound to @racket[id] is a @tech{module path index}, where @racket[_module-path] is treated as relative (if it is relative) to the module that is the home of the @tech{variable reference} @racket[_var-ref], where @racket[_var-ref] diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index 25c7980fa6..1ec236486e 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -1131,20 +1131,31 @@ p))) (let ([p (cond [(bytes? p) (bytes->path p)] - [(and (list? p) (= 2 (length p)) + [(and (list? p) + (or (= 2 (length p)) + (= 3 (length p))) (eq? 'so (car p))) - (let ([fs (list - (cadr p) - (path-extra-suffix (cadr p) - (system-type 'so-suffix)))]) - (ormap (lambda (f) + (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))) - fs))] + (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) (eq? 'lib (car p))) (let ([p (if (null? (cddr p)) diff --git a/racket/collects/db/private/sqlite3/ffi.rkt b/racket/collects/db/private/sqlite3/ffi.rkt index a34a69a604..60948cbbcb 100644 --- a/racket/collects/db/private/sqlite3/ffi.rkt +++ b/racket/collects/db/private/sqlite3/ffi.rkt @@ -11,7 +11,7 @@ (define-runtime-path sqlite-so (case (system-type) [(windows) '(so "sqlite3")] - [else '(so "libsqlite3")])) + [else '(so "libsqlite3" ("0" #f))])) (define sqlite-lib (case (system-type) diff --git a/racket/collects/racket/runtime-path.rkt b/racket/collects/racket/runtime-path.rkt index 59d3862984..c0bcfc8af5 100644 --- a/racket/collects/racket/runtime-path.rkt +++ b/racket/collects/racket/runtime-path.rkt @@ -96,16 +96,41 @@ [(string? p) (string->path p)] [(path? p) p] [(and (list? p) - (= 2 (length p)) + (or (= 2 (length p)) + (= 3 (length p))) (eq? 'so (car p)) - (string? (cadr p))) - (let ([f (path-replace-suffix (cadr p) (system-type 'so-suffix))]) - (or (ormap (lambda (p) - (let ([p (build-path p f)]) - (and (file-exists? p) - p))) - (get-lib-search-dirs)) - (cadr 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))] [(and (list? p) ((length p) . > . 1) (eq? 'lib (car p))