suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make info-domain cache.ss file contain paths relative to the containing collection (but leave PLaneT cache.ss paths as absolute)

Browse Source 
svn: r2846
This commit is contained in:
Matthew Flatt 2006-04-29 02:36:31 +00:00
parent b06e4d40b2
commit e83bdb4e4a
2 changed files with 63 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/setup/getinfo.ss
View File

@ -81,35 +81,43 @@
;; Use the colls ht because a collection might be in multiple
;; collection paths, and we only want one
(let ([colls (make-hash-table 'equal)])
(for-each (lambda (f)
(when (file-exists? f)
(for-each
(lambda (i)
(match i
[((? bytes? pathbytes)
((? symbol? fields) ...)
key ;; anything is okay here
(? integer? maj)
(? integer? min))
(let ((old-items (hash-table-get
colls
key
(lambda () '())))
(new-item (list (bytes->path pathbytes) fields maj min)))
(hash-table-put! colls
key
((table-insert t) new-item old-items)))]
[_
(error 'find-relevant-directories
"bad info-domain cache entry: ~e in: ~a"
i
f)]))
(let ([l (with-input-from-file f read)])
(unless (list? l)
(error 'find-relevant-directories
"bad info-domain cache file: ~a"
f))
l))))
(for-each (lambda (f+root-dir)
(let ([f (car f+root-dir)]
[root-dir (cdr f+root-dir)])
(when (file-exists? f)
(for-each
(lambda (i)
(match i
[((? bytes? pathbytes)
((? symbol? fields) ...)
key ;; anything is okay here
(? integer? maj)
(? integer? min))
(let ((old-items (hash-table-get
colls
key
(lambda () '())))
(new-item (list (let ([p (bytes->path pathbytes)])
(if (and (relative-path? p) root-dir)
(build-path root-dir p)
p))
fields
maj
min)))
(hash-table-put! colls
key
((table-insert t) new-item old-items)))]
[_
(error 'find-relevant-directories
"bad info-domain cache entry: ~e in: ~a"
i
f)]))
(let ([l (with-input-from-file f read)])
(unless (list? l)
(error 'find-relevant-directories
"bad info-domain cache file: ~a"
f))
l)))))
(reverse (table-paths t)))
;; For each coll, invert the mapping, adding the col name to the list for each sym:
(hash-table-for-each colls
@ -134,10 +142,13 @@
[(eq? key 'preferred) preferred-table]
[(eq? key 'all-available) all-available-table]
[else (error 'find-relevant-directories "Invalid key: ~s" key)]))
;; A list of (cons cache.ss-path root-dir-path)
;; If root-dir-path is not #f, then paths in the cache.ss
;; file are relative to it. #f is used for the planet cache.ss file.
(define search-path
(cons user-infotable
(map (lambda (coll) (build-path coll "info-domain" "compiled" "cache.ss"))
(cons (cons user-infotable #f)
(map (lambda (coll) (cons (build-path coll "info-domain" "compiled" "cache.ss") coll))
(current-library-collection-paths))))
(unless (equal? (table-paths t) search-path)

25
collects/setup/setup-unit.ss
View File

@ -95,7 +95,7 @@
;; Find Collections ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct cc (collection path name info info-path shadowing-policy) (make-inspector))
(define-struct cc (collection path name info root-dir info-path shadowing-policy) (make-inspector))
(define (warning-handler v)
(lambda (exn)
@ -133,6 +133,7 @@
(apply collection-path collection-p)
name
info
root-dir
(build-path root-dir "info-domain" "compiled" "cache.ss")
;; by convention, all collections have "version" 1 0. This forces them
;; to conflict with each other.
@ -162,6 +163,7 @@
path
name
info
#f ; don't need root-dir; absolute paths in cache.ss will be ok
(get-planet-cache-path)
(list `(planet ,owner ,pkg-file ,@extra-path) maj min)))))
@ -653,9 +655,18 @@
(match i
[((? (lambda (a)
(and (bytes? a)
(file-exists? (build-path
(bytes->path a)
"info.ss"))))
(let ([p (bytes->path a)])
;; If we have a root directory, then the path
;; must be relative to it, otherwise it must
;; be absolute:
(and (if (cc-root-dir cc)
(relative-path? p)
(complete-path? p))
(file-exists? (build-path
(if (cc-root-dir cc)
(build-path (cc-root-dir cc) p)
p)
"info.ss"))))))
a)
((? symbol? b) ...)
c
@ -677,7 +688,11 @@
;; Add this collection's info to the table, replacing
;; any information already there.
(hash-table-put! t
(path->bytes (cc-path cc))
(path->bytes (if (cc-root-dir cc)
;; Use relative path:
(apply build-path (cc-collection cc))
;; Use absolute path:
(cc-path cc)))
(cons (domain) (cc-shadowing-policy cc))))))
ccs-to-compile)
;; Write out each collection-root-specific table to a "cache.ss" file: