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

avoid platform-specific path conventions in "info-cache.rktd"

Browse Source 
Store relative paths in "info-cache.rktd" (which corresponds,
roughly, to packages) in a platform-independent form, instead
of using the current platform's convention.

Using the current platform's covention works badly when
cross-compiling for Windows on Unix, since relative paths are used as
keys in the "info-cache.rktd" table. For example, updating a
pre-installed package on Windows mangles the mapping if the installer
is created from a cross-compiled installation.
This commit is contained in:
Matthew Flatt 2017-04-09 07:48:01 -06:00
parent 3bb131ecb2
commit 459a74455c
3 changed files with 52 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
racket/collects/setup/getinfo.rkt
View File

@ -5,7 +5,8 @@
planet/cachepath
syntax/modread
"dirs.rkt"
"path-relativize.rkt")
"path-relativize.rkt"
"private/encode-relative.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
@ -243,7 +244,9 @@
[else (error 'find-relevant-directories
"bad info-domain cache file: ~a" f)]))])
(match i
[(list (and pathbytes (or (? bytes?) (list (or 'info 'share) (? bytes?) ...)))
[(list (and pathbytes (or (? bytes?)
(list (or 'info 'share) (? bytes?) ...)
(list 'rel (or 'up (? bytes?)) ...)))
(list (? symbol? fields) ...)
key ;; anything is okay here
(? integer? maj)
@ -259,9 +262,10 @@
;; but it's ok to support them:
(simplify-path (build-path root-dir p))
p))
(if (eq? (car pathbytes) 'info)
(info-relative->path pathbytes)
(main-share-relative->path pathbytes)))
(case (car pathbytes)
[(rel) (simplify-path (build-path root-dir (decode-relative-path pathbytes)))]
[(info) (info-relative->path pathbytes)]
[(lib) (main-share-relative->path pathbytes)]))
fields)])
(hash-set! colls key
((table-insert t) root-dir new-item old-items)))]

21
racket/collects/setup/private/encode-relative.rkt Normal file
View File

@ -0,0 +1,21 @@
#lang racket/base
;; Similar to "../path-relativize.rkt", but works on already-releative
;; paths and allows ".." in the path.
(provide encode-relative-path
decode-relative-path)
(define (encode-relative-path p)
(cons 'rel
(for/list ([e (in-list (explode-path p))])
(if (path? e)
(path-element->bytes e)
e))))
(define (decode-relative-path l)
(apply build-path
(for/list ([e (in-list (cdr l))])
(if (bytes? e)
(bytes->path-element e)
e))))

28
racket/collects/setup/setup-core.rkt
View File

@ -39,6 +39,7 @@
"private/pkg-deps.rkt"
"collection-name.rkt"
"private/format-error.rkt"
"private/encode-relative.rkt"
compiler/private/dep
(only-in pkg/lib pkg-directory
pkg-single-collection))
@ -1160,9 +1161,23 @@
(set! all-ok? #t)
(for ([i l])
(match i
[(list (and a (or (? bytes?) (list (or 'info 'lib) (? bytes?) ...)))
[(list (and a (or (? bytes?)
(list (or 'info 'lib) (? bytes?) ...)
(list 'rel (or 'up (? bytes?)) ...)))
(list (? symbol? b) ...) c (? integer? d) (? integer? e))
(define p (if (bytes? a) (bytes->path a) a))
(define p
(cond
[(bytes? a) (bytes->path a)]
[(and (pair? a) (eq? 'rel (car a)))
(decode-relative-path a)]
[else a]))
(define (normalize-relative-encoding a p)
(if (and (bytes? a) (relative-path? p))
;; Convert to encoded form, since new entries will
;; use encoding to avoid path-convention problems
;; with cross-compilation:
(encode-relative-path p)
a))
;; Check that the path is suitably absolute or relative:
(define dir
(case info-path-mode
@ -1219,7 +1234,7 @@
(not (eq? 'all (omitted-paths dir getinfo/log-failure 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))
(hash-set! t (normalize-relative-encoding a p) (list b c d e))
(begin (when (verbose) (printf " drop entry: ~s\n" i))
(set! all-ok? #f)))]
[_ (when (verbose) (printf " bad entry: ~s\n" i))
@ -1263,9 +1278,10 @@
(let ([p (path->main-lib-relative (cc-path cc))])
(if (path? p)
;; Fall back to relative (with ".."s) to info root:
(path->bytes (find-relative-path (cc-info-root cc)
p
#:more-than-root? #t))
(encode-relative-path
(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)))))