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

Making the distribution checker agnostic to the actual base name of the plt root

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-20 10:32:11 -06:00
parent 54e16b18ff
commit 67b7961464
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/meta/checker.rkt
View File

@ -69,22 +69,26 @@
(provide get-tree)
;; path -> tree
;; Returns the tree with path (a string with no "/"s) at its root.
(define (get-tree path)
(define (get-tree path fake-path)
(define base (regexp-replace #rx"/$" (path->string (cd)) ""))
(let loop ([name path] [path ""])
(let loop ([name path] [fake-name fake-path] [path ""] [fake-path ""])
(cond [(or (file-exists? name) (link-exists? name))
(let ([path (concat path name)])
(prop-set! path 'base base)
(prop-set! path 'name name)
path)]
(let ([path (concat path name)]
[fake-path (concat fake-path fake-name)])
(prop-set! fake-path 'base base)
(prop-set! fake-path 'name name)
(prop-set! fake-path 'real path)
fake-path)]
[(directory-exists? name)
(let ([path (concat path name "/")])
(prop-set! path 'base base)
(prop-set! path 'name name)
(let ([path (concat path name "/")]
[fake-path (concat fake-path fake-name "/")])
(prop-set! fake-path 'base base)
(prop-set! fake-path 'name name)
(prop-set! fake-path 'real path)
(parameterize ([cd name])
(cons path (map (lambda (name) (loop name path))
(dir-list)))))]
[else (error 'get-tree "strange entry: ~a/~a"
(cons fake-path (map (lambda (name) (loop name name path fake-path))
(dir-list)))))]
[else (error 'get-tree/base "strange entry: ~a/~a"
(path->string (cd)) name)])))
(provide tree-path)
@ -469,7 +473,7 @@
(if (pair? tree)
(for-each loop (cdr tree))
(parameterize ([cd (prop-get tree 'base)])
(prop-set! tree 'contents (read-depfile tree)))))
(prop-set! tree 'contents (read-depfile (prop-get tree 'real))))))
(dprintf " done.\n")
(set! add-dependency-contents! void))
@ -562,7 +566,7 @@
(dprintf "Scanning main tree...")
(set! *racket-tree*
(let loop ([tree (parameterize ([cd racket-base/])
(get-tree racket/-name))]
(get-tree racket/-name "racket"))]
[trees (apply append *platform-tree-lists*)])
(if (null? trees)
(tree-filter '(not junk) tree)