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

added a very rudimentary system for detecting which files are conflicting

Browse Source 
svn: r5948
This commit is contained in:
Jacob Matthews 2007-04-16 01:16:16 +00:00
parent 5d1f33670a
commit dd93bb18b8
1 changed files with 41 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/planet/resolver.ss
View File

@ -246,28 +246,53 @@ an appropriate subdirectory.
[compat? (build-compatibility-fn (info 'can-be-loaded-with (lambda () 'none)))]) [compat? (build-compatibility-fn (info 'can-be-loaded-with (lambda () 'none)))])
(compat? pkg1))])) (compat? pkg1))]))
;; stx->origin-string : stx option -> string
;; returns a description [e.g. file name, line#] of the given syntax
(define (stx->origin-string stx)
(if stx
(format "~a" (syntax-source stx))
"[unknown]"))
(define (add-pkg-to-diamond-registry! pkg) (define (add-pkg-to-diamond-registry! pkg stx)
(let ((loaded-packages (hash-table-get (the-version-cache) (let ((loaded-packages (hash-table-get (the-version-cache)
(pkg->diamond-key pkg) (pkg->diamond-key pkg)
(lambda () '())))) (lambda () '()))))
(begin (begin
(unless (list? loaded-packages) (unless (list? loaded-packages)
(error 'PLaneT "Inconsistent state: expected loaded-packages to be a list, received: ~s" loaded-packages)) (error 'PLaneT "Inconsistent state: expected loaded-packages to be a list, received: ~s" loaded-packages))
(for-each (let* ([all-violations '()]
(lambda (already-loaded-pkg) [_
(unless (can-be-loaded-together? pkg already-loaded-pkg) (for-each
(raise (make-exn:fail (format (lambda (already-loaded-pkg-record)
"Package ~a loaded twice with multiple incompatible versions: (let* ([already-loaded-pkg (car already-loaded-pkg-record)]
attempted to load version ~a.~a while version ~a.~a was already loaded" [stx (cadr already-loaded-pkg-record)]
(pkg-name pkg) [stx-origin-string (stx->origin-string stx)])
(pkg-maj pkg) (unless (can-be-loaded-together? pkg already-loaded-pkg)
(pkg-min pkg) (set!
(pkg-maj already-loaded-pkg) all-violations
(pkg-min already-loaded-pkg)) (cons
(current-continuation-marks))))) (list
loaded-packages) stx
(hash-table-put! (the-version-cache) (pkg->diamond-key pkg) (cons pkg loaded-packages))))) (make-exn:fail
(format
"Package ~a loaded twice with multiple incompatible versions:
~a attempted to load version ~a.~a while version ~a.~a was already loaded by ~a"
(pkg-name pkg)
(stx->origin-string stx)
(pkg-maj pkg)
(pkg-min pkg)
(pkg-maj already-loaded-pkg)
(pkg-min already-loaded-pkg)
stx-origin-string)
(current-continuation-marks)))
all-violations)))))
loaded-packages)])
(unless (null? all-violations)
(let ([worst (or (assq values all-violations) (car all-violations))])
(raise (cadr worst)))))
(hash-table-put! (the-version-cache)
(pkg->diamond-key pkg)
(cons (list pkg stx) loaded-packages)))))
; ========================================================================================== ; ==========================================================================================
; MAIN LOGIC ; MAIN LOGIC
@ -279,7 +304,7 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
; environment ; environment
(define (planet-resolve spec module-path stx load?) (define (planet-resolve spec module-path stx load?)
(let-values ([(path pkg) (get-planet-module-path/pkg spec module-path stx)]) (let-values ([(path pkg) (get-planet-module-path/pkg spec module-path stx)])
(when load? (add-pkg-to-diamond-registry! pkg)) (when load? (add-pkg-to-diamond-registry! pkg stx))
(do-require path (pkg-path pkg) module-path stx load?))) (do-require path (pkg-path pkg) module-path stx load?)))
;; resolve-planet-path : planet-require-spec -> path ;; resolve-planet-path : planet-require-spec -> path