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

Fixed an oversight that broke the linkage table

Browse Source 
svn: r3956
This commit is contained in:
Jacob Matthews 2006-08-04 14:59:30 +00:00
parent 4a4ece4e00
commit 9bc45dfb51
2 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/planet/private/linkage.ss
View File

@ -25,6 +25,7 @@
(if linked-pkg (if linked-pkg
(success-k linked-pkg) (success-k linked-pkg)
(failure-k (failure-k
void
(λ (pkg) (add-linkage! module-specifier pkg-specifier pkg)) (λ (pkg) (add-linkage! module-specifier pkg-specifier pkg))
(λ (x) x))))) (λ (x) x)))))

37
collects/planet/resolver.ss
View File

@ -298,13 +298,14 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
(cond (cond
[(string? result) [(string? result)
(raise-syntax-error 'require (string->immutable-string result) stx)] (raise-syntax-error 'require (string->immutable-string result) stx)]
[(pkg-promise? result) [(pkg? result)
(let ([pkg (pkg-promise->pkg result)]) (values (apply build-path (pkg-path result) (append path (list file-name))) result)]))]
(values (apply build-path (pkg-path pkg) (append path (list file-name))) pkg))]))]
[_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~e" (cdr spec)) stx)])) [_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~e" (cdr spec)) stx)]))
;; PKG-GETTER ::= module-path pspec
;; PKG-GETTER ::= module-path pspec (pkg -> A) ((pkg -> void) ((string | #f) -> string | #f) -> A) -> A ;; (pkg -> A)
;; ((uninstalled-pkg -> void) (pkg -> void) ((string | #f) -> string | #f) -> A)
;; -> A
;; ;;
;; a pkg-getter is a function that tries to fetch a package; it is written in a quasi-cps style; ;; a pkg-getter is a function that tries to fetch a package; it is written in a quasi-cps style;
;; the first argument is what it calls to succeed, and the second argument is what it calls when it ;; the first argument is what it calls to succeed, and the second argument is what it calls when it
@ -319,7 +320,8 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
;; or returns a descriptive error message string if that's not possible ;; or returns a descriptive error message string if that's not possible
(define (get-package module-path pspec) (define (get-package module-path pspec)
(let loop ([getters (*package-search-chain*)] (let loop ([getters (*package-search-chain*)]
[updaters '()] [pre-install-updaters '()]
[post-install-updaters '()]
[error-reporters '()]) [error-reporters '()])
(cond (cond
[(null? getters) [(null? getters)
@ -338,11 +340,15 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
module-path module-path
pspec pspec
(λ (pkg) (λ (pkg)
(for-each (λ (u) (u pkg)) updaters) (when (uninstalled-pkg? pkg)
pkg) (for-each (λ (u) (u pkg)) pre-install-updaters))
(λ (updater error-reporter) (let ([installed-pkg (pkg-promise->pkg pkg)])
(for-each (λ (u) (u installed-pkg)) post-install-updaters)
installed-pkg))
(λ (pre-updater post-updater error-reporter)
(loop (cdr getters) (loop (cdr getters)
(cons updater updaters) (cons pre-updater pre-install-updaters)
(cons post-updater post-install-updaters)
(cons error-reporter error-reporters))))]))) (cons error-reporter error-reporters))))])))
; pkg-spec->full-pkg-spec : PKG-SPEC syntax -> FULL-PKG-SPEC ; pkg-spec->full-pkg-spec : PKG-SPEC syntax -> FULL-PKG-SPEC
@ -388,7 +394,7 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
; get/installed-cache : pkg-getter ; get/installed-cache : pkg-getter
(define (get/installed-cache module-spec pkg-spec success-k failure-k) (define (get/installed-cache module-spec pkg-spec success-k failure-k)
(let ([p (lookup-package pkg-spec)]) (let ([p (lookup-package pkg-spec)])
(if p (success-k p) (failure-k void (λ (x) x))))) (if p (success-k p) (failure-k void void (λ (x) x)))))
; get-package-from-cache : FULL-PKG-SPEC -> PKG | #f ; get-package-from-cache : FULL-PKG-SPEC -> PKG | #f
(define (get-package-from-cache pkg-spec) (define (get-package-from-cache pkg-spec)
@ -411,11 +417,8 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
(pkg-maj p) (pkg-maj p)
(pkg-min p))) (pkg-min p)))
(failure-k (failure-k
(λ (pkg-promise) save-to-uninstalled-pkg-cache!
(cond void
[(uninstalled-pkg? pkg-promise)
(save-to-uninstalled-pkg-cache! pkg-promise)]
[else (void)]))
(λ (x) x))))) (λ (x) x)))))
;; save-to-uninstalled-pkg-cache! : uninstalled-pkg -> void ;; save-to-uninstalled-pkg-cache! : uninstalled-pkg -> void
@ -448,7 +451,7 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
[(pkg-promise? p) (success-k p)] [(pkg-promise? p) (success-k p)]
[(string? p) [(string? p)
; replace any existing error message with the server download error message ; replace any existing error message with the server download error message
(failure-k void (λ (_) p))]))) (failure-k void void (λ (_) p))])))
; get-package-from-server : FULL-PKG-SPEC -> PKG-PROMISE | #f | string[error message] ; get-package-from-server : FULL-PKG-SPEC -> PKG-PROMISE | #f | string[error message]
; downloads the given package file from the PLaneT server and installs it in the ; downloads the given package file from the PLaneT server and installs it in the