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

fix mismatched path normalizations in `raco setup'

Browse Source 
A mixture of filesystem-insensitive `simplify-path', filesystem-sensitive
 `simplify-path', and `normalize-path' was used in different parts
 of `raco setup'. This causes a mismatch, for example, when a Planet
 hard link uses a path that is a symlink.
 In general, I think filesystem-insensitive simplification (i.e., syntactic
 simplification) is the right choice for comparing paths, so that is now
 used consistently.
This commit is contained in:
Matthew Flatt 2010-06-03 13:46:21 -06:00
parent c3fdf47cc7
commit 7e08ef7064
3 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/setup/private/lib-roots.rkt
View File

@ -31,7 +31,7 @@
(reverse r)
(let ([x (and (list? x) (= 7 (length x)) (list-ref x 4))])
(loop (if (bytes? x)
(cons (cons (normalize-path (bytes->path x)) 0) r)
(cons (cons (simplify-path (bytes->path x) #f) 0) r)
r))))))))))))
(define path->library-root
@ -44,7 +44,7 @@
(unless (complete-path? path)
(raise-type-error 'path->library-root "complete-path" path))
(unless t (init-table))
(let loop ([rpath (reverse (explode-path (normalize-path path)))]
(let loop ([rpath (reverse (explode-path (simplify-path path #f)))]
[subdir '()])
(let ([x (hash-ref t rpath #f)])
(cond [(and x ((length subdir) . >= . x))

2
collects/setup/private/omitted-paths.rkt
View File

@ -86,7 +86,7 @@
(unless (and (path-string? dir) (complete-path? dir) (directory-exists? dir))
(raise-type-error 'omitted-paths
"complete path to an existing directory" dir))
(let* ([dir* (explode-path (simplify-path dir))]
(let* ([dir* (explode-path (simplify-path dir #f))]
[r (ormap (lambda (root+table)
(let ([r (relative-from dir* (car root+table))])
(and r (cons (reverse r) root+table))))

6
collects/setup/setup-unit.rkt
View File

@ -404,8 +404,8 @@
(for ([path paths])
(let ([full-path (build-path (cc-path cc) path)])
(when (or (file-exists? full-path) (directory-exists? full-path))
(let ([path (find-relative-path (normalize-path (cc-path cc))
(normalize-path full-path))])
(let ([path (find-relative-path (simplify-path (cc-path cc) #f)
(simplify-path full-path #f))])
(let loop ([path path])
(let-values ([(base name dir?) (split-path path)])
(cond
@ -888,7 +888,7 @@
'())))
(current-library-collection-paths
(map simplify-path (current-library-collection-paths)))
(map (lambda (p) (simplify-path p #f)) (current-library-collection-paths)))
(setup-printf "version" "~a [~a]" (version) (system-type 'gc))
(setup-printf "variants" "~a" (string-join (map symbol->string (available-mzscheme-variants)) ", "))