Revert "avoid calling pkg->path from DrRacket's manager-skip-file-handler"

The reverted commit assumed that all pkgs were in either (get-pkgs-search-dirs)
or (find-user-pkgs-dir), which is a bogus assumption

This reverts commit b600dcc7bc.
This commit is contained in:
Robby Findler 2014-03-28 07:36:04 -05:00
parent b600dcc7bc
commit 1effcac706

View File

@ -3,7 +3,6 @@
racket/draw racket/draw
racket/list racket/list
racket/set racket/set
racket/path
compiler/cm compiler/cm
setup/dirs setup/dirs
planet/config planet/config
@ -74,44 +73,28 @@
(compile-enforce-module-constants (prefab-module-settings-enforce-module-constants settings)) (compile-enforce-module-constants (prefab-module-settings-enforce-module-constants settings))
(define path->pkg-cache (make-hash)) (define path->pkg-cache (make-hash))
(when (prefab-module-settings-compilation-on? settings) (when (prefab-module-settings-compilation-on? settings)
(define-values (open-pkg-exploded-dirs open-pkgs) (define open-pkgs
(for/fold ([exploded-dirs (set)] [pkgs (set)]) ([path (in-list currently-open-files)]) (for/fold ([s (set)]) ([path (in-list currently-open-files)])
(define pkg (path->pkg path #:cache path->pkg-cache)) (define pkg (path->pkg path #:cache path->pkg-cache))
(cond (if (and pkg
[pkg (memq 'write
(define dir (pkg-directory pkg)) (file-or-directory-permissions (pkg-directory pkg))))
(if (memq 'write (set-add s pkg)
(file-or-directory-permissions dir)) s)))
(values (set-add exploded-dirs (explode-path (simple-form-path dir)))
(set-add pkgs pkg))
(values exploded-dirs pkgs))]
[else (values exploded-dirs pkgs)])))
(for ([pkg (in-set open-pkgs)]) (for ([pkg (in-set open-pkgs)])
(log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg)) (log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg))
(define (in-open-pkg? p)
(cond
[(set-empty? open-pkg-exploded-dirs) #f]
[else
(define exp-p (explode-path (simple-form-path p)))
(define exp-p-len (length exp-p))
(for/or ([exploded-dir (in-set open-pkg-exploded-dirs)])
(and (<= (length exploded-dir) exp-p-len)
(for/and ([pkg-ele (in-list exploded-dir)]
[p-ele (in-list exp-p)])
(equal? pkg-ele p-ele))))]))
(define skip-path? (define skip-path?
(let* ([cd (find-collects-dir)] (let* ([cd (find-collects-dir)]
[sd (find-share-dir)] [sd (find-share-dir)]
[no-dirs (append [no-dirs (append
(list (CACHE-DIR) (list (CACHE-DIR))
(find-user-pkgs-dir))
(if cd (list cd) null) (if cd (list cd) null)
(if sd (list sd) null) (if sd (list sd) null))])
(filter directory-exists? (λ (p) (or (file-stamp-in-paths p no-dirs)
(get-pkgs-search-dirs)))]) (let ([pkg (path->pkg p #:cache path->pkg-cache)])
(λ (p) (and pkg
(and (not (in-open-pkg? p)) (not (set-member? open-pkgs pkg))
(file-stamp-in-paths p no-dirs))))) (file-stamp-in-paths p (list (pkg-directory pkg)))))))))
(define extra-compiled-file-path (define extra-compiled-file-path
(case (prefab-module-settings-annotations settings) (case (prefab-module-settings-annotations settings)
[(none) (build-path "compiled" "drracket")] [(none) (build-path "compiled" "drracket")]