change "cache.rktd" format to be platform-independent
The format previously included relative paths in the syntax of the platform used to run `raco setup'. While a "cache.rktd" built on Unix would work for Windows, the reverse would not be true. Also, `raco setup' under Windows would get confused because it would arrive at different relative paths for the same collection (e.g., "drracket/private" and "drracket\\private"). The portable representation of relative paths is also normalized. A "cache.rktd" file still has absolute paths for Planet packages or links installed with `raco link', but that's not a problem for packaging a distribution with a portable "cache.rktd". Also, `raco setup' cleans "cache.rtkd" by removing collections that are omitted and by not including collections that have no "info.rkt"/"info.ss" file.
This commit is contained in:
Matthew Flatt
parent
0fbed43a26
commit
959db06c7c
|
|
@ -1,6 +1,10 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require scheme/match scheme/contract planet/cachepath syntax/modread)
|
||||
(require scheme/match
|
||||
scheme/contract
|
||||
planet/cachepath
|
||||
syntax/modread
|
||||
"path-relativize.rkt")
|
||||
|
||||
;; in addition to infodomain/compiled/cache.rktd, getinfo will look in this
|
||||
;; file to find mappings. PLaneT uses this to put info about installed
|
||||
|
|
@ -118,6 +122,12 @@
|
|||
(for ([f+root-dir (reverse (table-paths t))])
|
||||
(let ([f (car f+root-dir)]
|
||||
[root-dir (cdr f+root-dir)])
|
||||
(define-values (path->info-relative
|
||||
info-relative->path)
|
||||
(make-relativize (lambda () root-dir)
|
||||
'info
|
||||
'path->info-relative
|
||||
'info-relative->path))
|
||||
(when (file-exists? f)
|
||||
(for ([i (let ([l (with-input-from-file f read)])
|
||||
(cond [(list? l) l]
|
||||
|
|
@ -125,7 +135,7 @@
|
|||
[else (error 'find-relevant-directories
|
||||
"bad info-domain cache file: ~a" f)]))])
|
||||
(match i
|
||||
[(list (? bytes? pathbytes)
|
||||
[(list (and pathbytes (or (? bytes?) (list 'info (? bytes?) ...)))
|
||||
(list (? symbol? fields) ...)
|
||||
key ;; anything is okay here
|
||||
(? integer? maj)
|
||||
|
|
@ -134,10 +144,14 @@
|
|||
[new-item
|
||||
(make-directory-record
|
||||
maj min key
|
||||
(let ([p (bytes->path pathbytes)])
|
||||
(if (and (relative-path? p) root-dir)
|
||||
(build-path root-dir p)
|
||||
p))
|
||||
(if (bytes? pathbytes)
|
||||
(let ([p (bytes->path pathbytes)])
|
||||
(if (and (relative-path? p) root-dir)
|
||||
;; `raco setup' doesn't generate relative paths anyway,
|
||||
;; but it's ok to support them:
|
||||
(build-path root-dir p)
|
||||
p))
|
||||
(info-relative->path pathbytes))
|
||||
fields)])
|
||||
(hash-set! colls key
|
||||
((table-insert t) new-item old-items)))]
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@
|
|||
"dirs.rkt"
|
||||
"main-collects.rkt"
|
||||
"path-to-relative.rkt"
|
||||
"path-relativize.rkt"
|
||||
"private/omitted-paths.rkt"
|
||||
"parallel-build.rkt"
|
||||
"collects.rkt"
|
||||
|
|
@ -792,8 +793,23 @@
|
|||
;; about those collections that exist in the same root as the ones in
|
||||
;; `collections-to-compile'.
|
||||
(let ([ht (make-hash)]
|
||||
[ht-orig (make-hash)])
|
||||
[ht-orig (make-hash)]
|
||||
[roots (make-hash)])
|
||||
(for ([cc ccs-to-compile])
|
||||
(define-values (path->info-relative info-relative->path)
|
||||
(apply values
|
||||
(hash-ref roots
|
||||
(cc-info-root cc)
|
||||
(lambda ()
|
||||
(define-values (p-> ->p)
|
||||
(if (cc-info-root cc)
|
||||
(make-relativize (lambda () (cc-info-root cc))
|
||||
'info
|
||||
'path->info-relative
|
||||
'info-relative->path)
|
||||
(values #f #f)))
|
||||
(hash-set! roots (cc-info-root cc) (list p-> ->p))
|
||||
(list p-> ->p)))))
|
||||
(let* ([domain (with-handlers ([exn:fail? (lambda (x) (lambda () null))])
|
||||
(dynamic-require
|
||||
(build-path (cc-path cc) "info.rkt")
|
||||
|
|
@ -817,13 +833,16 @@
|
|||
(set! all-ok? #t)
|
||||
(for ([i l])
|
||||
(match i
|
||||
[(list (? bytes? a) (list (? symbol? b) ...) c (? integer? d) (? integer? e))
|
||||
(let ([p (bytes->path a)])
|
||||
[(list (and a (or (? bytes?) (list 'info (? bytes?) ...)))
|
||||
(list (? symbol? b) ...) c (? integer? d) (? integer? e))
|
||||
(let ([p (if (bytes? a)
|
||||
(bytes->path a)
|
||||
a)])
|
||||
;; Check that the path is suitably absolute or relative:
|
||||
(let ([dir (case (cc-info-path-mode cc)
|
||||
[(relative abs-in-relative)
|
||||
(or (and (relative-path? p)
|
||||
(build-path (cc-info-root cc) p))
|
||||
(or (and (list? p)
|
||||
(info-relative->path p))
|
||||
(and (complete-path? p)
|
||||
;; `c' must be `(lib ...)'
|
||||
(list? c)
|
||||
|
|
@ -839,11 +858,25 @@
|
|||
(and (complete-path? p)
|
||||
p)])])
|
||||
(if (and dir
|
||||
(let ([omit-root
|
||||
(if (path? p)
|
||||
;; absolute path => need a root for checking omits;
|
||||
;; for a collection path of length N, go up N-1 dirs:
|
||||
(simplify-path (apply build-path p (for/list ([i (cddr c)]) 'up)) #f)
|
||||
;; relative path => no root needed for checking omits:
|
||||
#f)])
|
||||
(not (eq? 'all (omitted-paths dir getinfo omit-root))))
|
||||
(or (file-exists? (build-path dir "info.rkt"))
|
||||
(file-exists? (build-path dir "info.ss"))))
|
||||
(hash-set! t a (list b c d e))
|
||||
(set! all-ok? #f))))]
|
||||
[_ (set! all-ok? #f)])))
|
||||
(begin
|
||||
(when (verbose)
|
||||
(printf " drop entry: ~s\n" i))
|
||||
(set! all-ok? #f)))))]
|
||||
[_
|
||||
(when (verbose)
|
||||
(printf " bad entry: ~s\n" i))
|
||||
(set! all-ok? #f)])))
|
||||
;; Record the table loaded for this collection root
|
||||
;; in the all-roots table:
|
||||
(hash-set! ht (cc-info-path cc) t)
|
||||
|
|
@ -854,14 +887,18 @@
|
|||
(and all-ok? (hash-copy t)))
|
||||
t))))])
|
||||
;; Add this collection's info to the table, replacing any information
|
||||
;; already there.
|
||||
(hash-set! t
|
||||
(path->bytes (if (eq? (cc-info-path-mode cc) 'relative)
|
||||
;; Use relative path:
|
||||
(apply build-path (cc-collection cc))
|
||||
;; Use absolute path:
|
||||
(cc-path cc)))
|
||||
(cons (domain) (cc-shadowing-policy cc)))))
|
||||
;; already there, if the collection has an "info.ss" file:
|
||||
(when (or (file-exists? (build-path (cc-path cc) "info.rkt"))
|
||||
(file-exists? (build-path (cc-path cc) "info.ss")))
|
||||
(hash-set! t
|
||||
(if (eq? (cc-info-path-mode cc) 'relative)
|
||||
;; Use relative path:
|
||||
(path->info-relative (apply build-path
|
||||
(cc-info-root cc)
|
||||
(cc-collection cc)))
|
||||
;; Use absolute path:
|
||||
(path->bytes (cc-path cc)))
|
||||
(cons (domain) (cc-shadowing-policy cc))))))
|
||||
;; Write out each collection-root-specific table to a "cache.rktd" file:
|
||||
(hash-for-each ht
|
||||
(lambda (info-path ht)
|
||||
|
|
@ -870,6 +907,16 @@
|
|||
(make-directory* base)
|
||||
(let ([p info-path])
|
||||
(setup-printf "updating" "~a" (path->relative-string/setup p))
|
||||
(when (verbose)
|
||||
(let ([ht0 (hash-ref ht-orig info-path)])
|
||||
(when ht0
|
||||
(for ([(k v) (in-hash ht)])
|
||||
(let ([v2 (hash-ref ht0 k #f)])
|
||||
(unless (equal? v v2)
|
||||
(printf " ~s -> ~s\n instead of ~s\n" k v v2))))
|
||||
(for ([(k v) (in-hash ht0)])
|
||||
(unless (hash-ref ht k #f)
|
||||
(printf " ~s removed\n" k))))))
|
||||
(with-handlers ([exn:fail? (warning-handler (void))])
|
||||
(with-output-to-file p
|
||||
#:exists 'truncate/replace
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user