repair for indrect dependencies

Fixes a problem with 95e85ec5bd that broke `raco setup -c`
This commit is contained in:
Matthew Flatt 2015-01-09 09:26:38 -07:00
parent d03e635ee4
commit 805cd95049
4 changed files with 59 additions and 27 deletions

View File

@ -10,7 +10,8 @@
openssl/sha1
racket/place
setup/collects
compiler/compilation-path)
compiler/compilation-path
compiler/private/dep)
(provide make-compilation-manager-load/use-compiled-handler
managed-compile-zo
@ -231,14 +232,8 @@
(define (get-dep-sha1s deps up-to-date collection-cache read-src-syntax mode roots must-exist? seen)
(let ([l (for/fold ([l null]) ([dep (in-list deps)])
(and l
;; (cons 'indirect dep) => indirect dependency (for pkg-dep checking)
;; (cons 'ext rel-path) => a non-module file, check source
;; rel-path => a module file name, check cache
(let* ([dep (if (and (pair? dep) (eq? 'indirect (car dep)))
(cdr dep)
dep)]
[ext? (and (pair? dep) (eq? 'ext (car dep)))]
[p (collects-relative*->path (if ext? (cdr dep) dep) collection-cache)])
(let* ([ext? (external-dep? dep)]
[p (collects-relative*->path (dep->encoded-path dep) collection-cache)])
(cond
[ext? (let ([v (get-source-sha1 p)])
(cond
@ -644,15 +639,9 @@
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
(maybe-compile-zo sha1-only? deps mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
[(ormap
(lambda (raw-p)
;; (cons 'indirect dep) => indirect dependency (for pkg-dep checking)
;; (cons 'ext rel-path) => a non-module file (check date)
;; rel-path => a module file name (check transitive dates)
(define p (if (and (pair? raw-p) (eq? 'indirect (car raw-p)))
(cdr raw-p)
raw-p))
(define ext? (and (pair? p) (eq? 'ext (car p))))
(define d (collects-relative*->path (if ext? (cdr p) p) collection-cache))
(lambda (p)
(define ext? (external-dep? p))
(define d (collects-relative*->path (dep->encoded-path p) collection-cache))
(define t
(if ext?
(cons (or (try-file-time d) +inf.0) #f)

View File

@ -0,0 +1,42 @@
#lang racket/base
(require setup/main-collects
racket/string)
(provide external-dep?
indirect-dep?
collects-relative-dep?
dep->path
dep->module-path
dep->encoded-path)
(define (external-dep? s)
(define (ext? s) (and (pair? s) (eq? 'ext (car s))))
(or (ext? s)
(and (indirect-dep? s)
(ext? (cdr s)))))
(define (indirect-dep? s)
(and (pair? s) (eq? 'indirect (car s))))
(define (collects-relative-dep? s)
(let ([s (dep->encoded-path s)])
(and (pair? s)
(eq? 'collects (car s)))))
(define (dep->path s)
(main-collects-relative->path (dep->encoded-path s)))
(define (dep->module-path s)
;; Assumes `collects-relative-dep?`
(define path-strs (map bytes->string/utf-8 (cdr (dep->encoded-path s))))
`(lib ,(string-join path-strs "/")))
(define (dep->encoded-path s)
(let* ([s (if (indirect-dep? s)
(cdr s)
s)]
[s (if (external-dep? s)
(cdr s)
s)])
s))

View File

@ -12,7 +12,8 @@
racket/path
setup/dirs
setup/doc-db
version/utils)
version/utils
compiler/private/dep)
(provide check-package-dependencies)
@ -489,11 +490,10 @@
;; Treat everything in ".dep" as 'build mode...
(define deps (cddr (call-with-input-file* (build-path dir f) read)))
(for ([dep (in-list deps)])
;; Note: indirect dependencies (which start with 'indirect) are ignored
(when (and (pair? dep)
(eq? 'collects (car dep)))
(define path-strs (map bytes->string/utf-8 (cdr dep)))
(define mod `(lib ,(string-join path-strs "/")))
(when (and (not (external-dep? dep))
(not (indirect-dep? dep))
(collects-relative-dep? dep))
(define mod (dep->module-path dep))
(check-mod! mod 'build pkg f dir)))))
;; Treat all (direct) documentation links as 'build mode:
(register-or-check-docs #t pkg path coll-main?))))

View File

@ -37,6 +37,7 @@
"private/elf.rkt"
"private/pkg-deps.rkt"
"collection-name.rkt"
compiler/private/dep
(only-in pkg/lib pkg-directory
pkg-single-collection))
@ -681,9 +682,9 @@
(with-input-from-file path read)))
(when (and (pair? deps) (list? deps))
(for ([s (in-list (cddr deps))])
(unless (and (pair? s) (eq? 'ext (car s)))
(define new-s (main-collects-relative->path s))
(when (path-string? new-s) (hash-set! dependencies new-s #t))))))
(unless (external-dep? s)
(define new-s (dep->path s))
(when (path-string? new-s) (hash-set! dependencies new-s #t))))))
(delete-file path))
(define (delete-files-in-directory path printout dependencies)