From 97e9a17dac6a5779fed7b5f86c0613cd1b547b59 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 13 May 2021 09:13:08 -0600 Subject: [PATCH] raco exe and dist: repairs for cross-bundling runtime files --- racket/collects/compiler/distribute.rkt | 33 ++++++++++++++++---- racket/collects/compiler/embed.rkt | 4 ++- racket/collects/racket/private/so-search.rkt | 14 +++++---- 3 files changed, 38 insertions(+), 13 deletions(-) diff --git a/racket/collects/compiler/distribute.rkt b/racket/collects/compiler/distribute.rkt index e2d8956f50..21458f26d0 100644 --- a/racket/collects/compiler/distribute.rkt +++ b/racket/collects/compiler/distribute.rkt @@ -446,10 +446,9 @@ (loop (cdr exts) (inc-counter counter))]) (values (if src (cons (transform-entry - (path->bytes - (relative->binary-relative (car sub-dirs) - (car types) - (build-path relative-exts-dir sub dest))) + (relative->binary-relative (car sub-dirs) + (car types) + (build-path relative-exts-dir sub dest)) (car exts)) rest-exts) (cons (car exts) @@ -495,7 +494,7 @@ name)) ;; transform-entry (lambda (new-path ext) - (list new-path (cadr ext))) + (list (path->cross-bytes new-path) (cadr ext))) 0 add1 ; <- counter orig-binaries binaries types sub-dirs exts-dir relative-exts-dir @@ -619,7 +618,7 @@ (set! exploded (cdr exploded))))) ;; transform-entry (lambda (new-path ext) - (cons (car ext) (list new-path))) + (cons (car ext) (list (path->cross-bytes new-path)))) "rt" values ; <- counter orig-binaries binaries types sub-dirs exts-dir relative-exts-dir @@ -636,6 +635,28 @@ (string->path s) s)) + (define (path->cross-bytes p) + (define cross-convention + ;; it would be nice to have `cross-system-path-convention`: + (case (cross-system-type) + [(windows) 'windows] + [else 'unix])) + (cond + [(eq? cross-convention (system-path-convention-type)) (path->bytes p)] + [else + (let loop ([p p] [accum '()]) + (define-values (base name dir?) (split-path p)) + (define new-accum (cons (if (path? name) + (bytes->path-element (path-element->bytes name) + cross-convention) + name) + accum)) + (cond + [(eq? base 'relative) (path->bytes (apply build-path/convention-type + cross-convention + new-accum))] + [else (loop base new-accum)]))])) + (define (get-binary-type b) ;; Since this is called first, we also check that the executable ;; is a stub binary for Unix or doesn't depend on shared libraries. diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index df25bb6799..954e9dfff9 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -1321,7 +1321,9 @@ (let ([p (cond [(bytes? p) (bytes->path p)] [(so-spec? p) - (define path (so-find p)) + (define path (so-find p + (cross-system-type 'so-suffix) + (get-cross-lib-search-dirs))) (cond [(and path embedded-dlls-box) (set-box! embedded-dlls-box (cons path (unbox embedded-dlls-box))) diff --git a/racket/collects/racket/private/so-search.rkt b/racket/collects/racket/private/so-search.rkt index 46b80f0ecd..abdab14d8c 100644 --- a/racket/collects/racket/private/so-search.rkt +++ b/racket/collects/racket/private/so-search.rkt @@ -25,13 +25,15 @@ (build-path base name) name)))) -(define (so-find p) +(define (so-find p + [so-suffix (system-type 'so-suffix)] + [lib-search-dirs (get-lib-search-dirs)]) (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) + [suffix-before-version? (not (equal? so-suffix #".dylib"))]) (ormap (lambda (dir) (ormap (lambda (vers) @@ -40,16 +42,16 @@ (path-extra-suffix (cadr p) (if (string? vers) (if suffix-before-version? - (bytes-append (system-type 'so-suffix) + (bytes-append so-suffix #"." (string->bytes/utf-8 vers)) (bytes-append #"." (string->bytes/utf-8 vers) - (system-type 'so-suffix))) - (system-type 'so-suffix))))]) + so-suffix)) + so-suffix)))]) (let ([p (build-path dir f)]) (and (or (file-exists? p) (directory-exists? p)) p)))) verss)) - (get-lib-search-dirs)))) + lib-search-dirs)))