fix some absolute paths in an in-place build
This commit is contained in:
parent
301bdf9764
commit
267ba4c72b
|
@ -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))]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user