diff --git a/pkgs/racket-test/tests/pkg/shelly.rkt b/pkgs/racket-test/tests/pkg/shelly.rkt index 0b2f93bd6e..189ae6cde8 100644 --- a/pkgs/racket-test/tests/pkg/shelly.rkt +++ b/pkgs/racket-test/tests/pkg/shelly.rkt @@ -3,6 +3,7 @@ racket/port racket/system racket/match + compiler/find-exe (for-syntax racket/base syntax/parse)) @@ -56,8 +57,8 @@ #:attr code (quasisyntax/loc - #'command-line - (let ([cmd command-line]) + #'command-line + (let ([cmd (rename-racket command-line)]) (check-case cmd (define output-port (open-output-string)) @@ -144,4 +145,32 @@ (shelly-begin after ...))))])) ;; }} +(define racket-run-suffix + (let () + (define racket (find-exe)) + (cond + [racket + (define-values (base name dir?) (split-path racket)) + (define m (regexp-match #rx"^(?i:racket)(.*)$" (path-element->string name))) + (define suffix (and m (cadr m))) + (and (not (equal? suffix "")) + suffix)] + [else #f]))) + +;; Add a suffix ro "racket" or "raco", if there's one on the current executable +(define rename-racket + (cond + [racket-run-suffix + ;; Adjust comands by adding a suffix: + (lambda (cmd) + (cond + [(regexp-match-positions #rx"^(racket|raco) " cmd) + => (lambda (m) + (string-append (substring cmd 0 (cdadr m)) + racket-run-suffix + (substring cmd (cdadr m))))] + [else cmd]))] + [else + (lambda (cmd) cmd)])) + (provide (all-defined-out)) diff --git a/pkgs/racket-test/tests/pkg/tests-binary.rkt b/pkgs/racket-test/tests/pkg/tests-binary.rkt index 3a1fbccd09..bf2b291796 100644 --- a/pkgs/racket-test/tests/pkg/tests-binary.rkt +++ b/pkgs/racket-test/tests/pkg/tests-binary.rkt @@ -143,6 +143,10 @@ (let ([src (path->complete-path (format "test-pkgs/src-pkgs/pkg-~a.zip" name))] [bin (path->complete-path (format "test-pkgs/pkg-~a.zip" name))] [blt (path->complete-path (format "test-pkgs/built-pkgs/pkg-~a.zip" name))]) + (define compiled-dir (let ([l (use-compiled-file-paths)]) + (if (null? l) + (string->path-element "compiled") + (car l)))) (define sd (build-path tmp-dir name "src")) (define bd (build-path tmp-dir name "bin")) (define td (build-path tmp-dir name "blt")) @@ -167,7 +171,7 @@ (when (regexp-match? #rx#"[.](rkt|scrbl|ss)$" f) (let-values ([(base name dir?) (split-path f)]) (unless (file-exists? (build-path (if (eq? base 'relative) 'same base) - "compiled" + compiled-dir (path-add-suffix name #".zo"))) (unless (regexp-match? #rx#"^(?:info.rkt|x/keep.scrbl)$" f) (error 'build "compiled file missing for ~s" f))))))) @@ -189,10 +193,14 @@ (and (path? base) (let-values ([(base name dir?) (split-path base)]) (or (eq? base 'relative) - (and (path? name) - (equal? (path->string name) "compiled") - (let-values ([(base name dir?) (split-path base)]) - (eq? base 'relative)))))))))) + (let loop ([elems (explode-path compiled-dir)] [name name] [base base]) + (and (path? name) + (cond + [(eq? base 'relative) #t] + [(null? elems) #f] + [(equal? (path->string name) (path->string compiled-dir)) + (let-values ([(base name dir?) (split-path base)]) + (loop (cdr elems) name base))])))))))))) (for ([f (in-directory)]) (when (file-exists? f) (unless (file-exists? (build-path td f)) diff --git a/pkgs/racket-test/tests/pkg/tests-conflicts.rkt b/pkgs/racket-test/tests/pkg/tests-conflicts.rkt index 94e7b6d9e9..c7305de4bf 100644 --- a/pkgs/racket-test/tests/pkg/tests-conflicts.rkt +++ b/pkgs/racket-test/tests/pkg/tests-conflicts.rkt @@ -169,8 +169,12 @@ (with-fake-root (shelly-case - "non-conflicts on .zo files that will be deletced by `raco setup`" + "non-conflicts on .zo files that will be deleted by `raco setup`" + (define compiled-dir (let ([l (use-compiled-file-paths)]) + (if (null? l) + "compiled" + (car l)))) (define (copy+install-not-conflict) (define t1nc-dir (make-temporary-file "~a-t1nc" 'directory)) (define src-dir "test-pkgs/pkg-test1-not-conflict/") @@ -184,18 +188,18 @@ (case mode [(src) (set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty") - (maybe-delete-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo")) + (maybe-delete-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo")) (maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))] [(both) (set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty") - (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...") + (set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...") (set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")] [(zo-stays) - (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...") + (set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...") (maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt")) (set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")] [(zo-goes) - (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...") + (set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...") (maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt")) (maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))])) diff --git a/pkgs/racket-test/tests/pkg/util.rkt b/pkgs/racket-test/tests/pkg/util.rkt index d06ff1c8b7..6aad170129 100644 --- a/pkgs/racket-test/tests/pkg/util.rkt +++ b/pkgs/racket-test/tests/pkg/util.rkt @@ -19,8 +19,9 @@ ;; Use a consistent directory, so that individual tests can be ;; run after "tests-create.rkt": -(define-runtime-path test-directory (build-path (find-system-path 'temp-dir) - "pkg-test-work")) +(define test-directory (build-path (find-system-path 'temp-dir) + (string-append "pkg-test-work" + (or racket-run-suffix "")))) (define (sync-test-directory) (printf "Syncing test directory\n") diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index 965f1e5940..6c8114cab6 100644 --- a/racket/collects/pkg/strip.rkt +++ b/racket/collects/pkg/strip.rkt @@ -69,6 +69,15 @@ (check-directory-exists 'generate-stripped-directory "source " dir) (check-directory-exists 'generate-stripped-directory "destination " dest-dir) + (define compiled-dir + (case mode + [(binary binary-lib) + (define l (use-compiled-file-paths)) + (if (pair? l) + (car l) + "compiled")] + [else #f])) + (define drop-keep-ns (make-base-namespace)) (define (add-drop+keeps dir base drops keeps) (define get-info (get-info/full dir #:namespace drop-keep-ns)) @@ -115,7 +124,7 @@ #t))) (values (add drops more-drops) (add keeps more-keeps))) - + (define (drop-by-default? path get-p) (define bstr (path->bytes path)) (define (immediate-doc/css-or-doc/js?) @@ -139,7 +148,7 @@ (and (regexp-match? #rx"[.](?:ss|rkt)$" bstr) (not (equal? #"info.rkt" bstr)) (file-exists? (let-values ([(base name dir?) (split-path (get-p))]) - (build-path base "compiled" (path-add-suffix name #".zo"))))) + (build-path base compiled-dir (path-add-suffix name #".zo"))))) (immediate-doc/css-or-doc/js?) (case mode [(binary-lib)