From 7e08ef7064325a20e284852378906f117d82af04 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 3 Jun 2010 13:46:21 -0600 Subject: [PATCH] fix mismatched path normalizations in `raco setup' 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. --- collects/setup/private/lib-roots.rkt | 4 ++-- collects/setup/private/omitted-paths.rkt | 2 +- collects/setup/setup-unit.rkt | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/collects/setup/private/lib-roots.rkt b/collects/setup/private/lib-roots.rkt index 01e907b8de..8a5066ba82 100644 --- a/collects/setup/private/lib-roots.rkt +++ b/collects/setup/private/lib-roots.rkt @@ -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)) diff --git a/collects/setup/private/omitted-paths.rkt b/collects/setup/private/omitted-paths.rkt index ffe46fea4f..10faa21af3 100644 --- a/collects/setup/private/omitted-paths.rkt +++ b/collects/setup/private/omitted-paths.rkt @@ -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)))) diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt index 634a8a22ff..d3b0e871f4 100644 --- a/collects/setup/setup-unit.rkt +++ b/collects/setup/setup-unit.rkt @@ -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)) ", "))