From 267ba4c72b71785a1e38888dce3fd327c9f0b189 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 8 Jul 2013 19:27:55 -0600 Subject: [PATCH] fix some absolute paths in an in-place build --- racket/lib/collects/pkg/lib.rkt | 7 +++++-- racket/lib/collects/pkg/path.rkt | 3 ++- racket/lib/collects/setup/dirs.rkt | 9 ++++++++- racket/lib/collects/setup/setup-unit.rkt | 10 ++++++---- racket/src/link-all.rkt | 18 +++++++++++------- 5 files changed, 32 insertions(+), 15 deletions(-) diff --git a/racket/lib/collects/pkg/lib.rkt b/racket/lib/collects/pkg/lib.rkt index fe872fba78..caa74b38ca 100644 --- a/racket/lib/collects/pkg/lib.rkt +++ b/racket/lib/collects/pkg/lib.rkt @@ -582,7 +582,7 @@ (match-define (pkg-info orig-pkg checksum _) info) (match orig-pkg [`(,(or 'link 'static-link) ,orig-pkg-dir) - orig-pkg-dir] + (path->complete-path orig-pkg-dir (pkg-installed-dir))] [_ (build-path (pkg-installed-dir) pkg-name)])))) @@ -961,7 +961,10 @@ [(or (eq? type 'link) (eq? type 'static-link)) (install-info pkg-name - `(,type ,(simple-form-path* pkg)) + `(,type ,(path->string + (find-relative-path (pkg-installed-dir) + (simple-form-path pkg) + #:more-than-root? #t))) pkg #f #f (directory->module-paths pkg pkg-name metadata-ns))] diff --git a/racket/lib/collects/pkg/path.rkt b/racket/lib/collects/pkg/path.rkt index 2d7f16aa3b..727a50e86c 100644 --- a/racket/lib/collects/pkg/path.rkt +++ b/racket/lib/collects/pkg/path.rkt @@ -115,6 +115,7 @@ (and i (sc-pkg-info? i) (sc-pkg-info-collect i)))))] [else ;; Maybe it's a linked package + (define pkgs-dir (get-pkgs-dir scope)) (for/fold ([pkg #f] [subpath #f] [collect #f]) ([(k v) (in-hash (read-pkg-db/cached))] #:when (not pkg)) @@ -122,7 +123,7 @@ (if (and (pair? orig) (or (eq? 'link (car orig)) (eq? 'static-link (car orig)))) - (let ([orig-pkg-dir (cadr orig)]) + (let ([orig-pkg-dir (simplify-path (path->complete-path (cadr orig) pkgs-dir) #f)]) (define e (explode orig-pkg-dir)) (if (sub-path? <= p e) (values k diff --git a/racket/lib/collects/setup/dirs.rkt b/racket/lib/collects/setup/dirs.rkt index 128e5524e0..4e072d124a 100644 --- a/racket/lib/collects/setup/dirs.rkt +++ b/racket/lib/collects/setup/dirs.rkt @@ -9,7 +9,7 @@ ;; "config" (define config-dir - (delay (complete-path (find-system-path 'config-dir)))) + (delay (complete-path-from-exe (find-system-path 'config-dir)))) (define (find-config-dir) (force config-dir)) @@ -39,6 +39,13 @@ [else l])) (define (complete-path p) + (cond [(complete-path? p) p] + [else + (path->complete-path + p + (find-main-collects))])) + +(define (complete-path-from-exe p) (cond [(complete-path? p) p] [(absolute-path? p) (exe-relative p)] [else diff --git a/racket/lib/collects/setup/setup-unit.rkt b/racket/lib/collects/setup/setup-unit.rkt index a919984ccc..213325a927 100644 --- a/racket/lib/collects/setup/setup-unit.rkt +++ b/racket/lib/collects/setup/setup-unit.rkt @@ -964,9 +964,8 @@ (if (eq? (car p) 'info) (info-relative->path p) (main-lib-relative->path p))) - (and (complete-path? p) - ;; `c' must be `(lib ...)' - (list? c) + ;; `c' must be `(lib ...)' + (and (list? c) (pair? c) (eq? 'lib (car c)) (pair? (cdr c)) @@ -1031,7 +1030,10 @@ ;; Try relative to `lib': (let ([p (path->main-lib-relative (cc-path cc))]) (if (path? p) - (path->bytes p) + ;; Fall back to relative (with ".."s) to info root: + (path->bytes (find-relative-path (cc-info-root cc) + p + #:more-than-root? #t)) p))] [else (path->bytes (cc-path cc))]) (cons (domain) (cc-shadowing-policy cc))))) diff --git a/racket/src/link-all.rkt b/racket/src/link-all.rkt index 0f54387bc5..572aae0d08 100644 --- a/racket/src/link-all.rkt +++ b/racket/src/link-all.rkt @@ -10,7 +10,8 @@ (define config-dir-path (build-path "racket" "etc")) (define config-file-path (build-path config-dir-path "config.rktd")) -(define devel-pkgs-dir (build-path "racket" "lib" "devel-pkgs")) +(define devel-pkgs-rel-dir (build-path "devel-pkgs")) +(define devel-pkgs-dir (build-path "racket" "lib" devel-pkgs-rel-dir)) (define only-platform? #f) (define sticky? #f) @@ -61,19 +62,20 @@ (newline o))))) (define devel-pkgs-bytes - (path->bytes (path->complete-path devel-pkgs-dir))) + (path->bytes (build-path 'up devel-pkgs-rel-dir))) (define devel-links-bytes - (path->bytes (path->complete-path (build-path devel-pkgs-dir "links.rktd")))) + (path->bytes (build-path 'up devel-pkgs-rel-dir "links.rktd"))) (when (file-exists? config-file-path) (call-with-input-file* config-file-path (lambda (i) (define r (read i)) - (define (check what id bytes) + (define (check what id bytes alt-path) (define l (hash-ref r id #f)) (unless (and (list? l) - (member bytes l)) + (or (member bytes l) + (member (path->bytes (path->complete-path alt-path)) l))) (error 'link-all (~a "config file exists, but does not have a definition of `~a' that includes development ~a\n" " config file: ~a\n" @@ -85,10 +87,12 @@ bytes))) (check "packages" 'pkgs-search-dirs - devel-pkgs-bytes) + devel-pkgs-bytes + devel-pkgs-dir) (check "links" 'links-search-files - devel-links-bytes)))) + devel-links-bytes + (build-path devel-pkgs-dir "links.rktd"))))) ;; found: maps each available package name to a directory (define found (make-hash))