From fbc5fc75558c22e01297156cee93ecd6ea10c4ad Mon Sep 17 00:00:00 2001 From: Jacob Matthews Date: Tue, 24 Jan 2006 19:11:16 +0000 Subject: [PATCH] Misc. bugfixes for exceptional cases svn: r1945 --- collects/planet/private/planet-shared.ss | 13 ++++++++++--- collects/planet/resolver.ss | 7 +++++-- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index 41c3b86b9e..7325b48b60 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -203,7 +203,11 @@ Various common pieces of code that both the client and server need to access (define (string->mz-version str) (let ((ver (regexp-match #rx"^([0-9]+)(\\.([0-9]+))?$" str))) (if ver - (make-mz-version (string->number (list-ref ver 1)) (string->number (list-ref ver 3))) + (make-mz-version + (string->number (list-ref ver 1)) + (if (list-ref ver 3) + (string->number (list-ref ver 3)) + 0)) #f))) ;; version<= : mz-version mz-version -> boolean @@ -220,8 +224,11 @@ Various common pieces of code that both the client and server need to access (define (compatible-version? row spec) (let ((required-version (assoc-table-row->required-version row))) (or (not required-version) - (version<= (string->mz-version required-version) - (string->mz-version (pkg-spec-core-version spec)))))) + (let ((required (string->mz-version required-version)) + (provided (string->mz-version (pkg-spec-core-version spec)))) + (or (not required) + (not provided) + (version<= required provided)))))) ; get-best-match : assoc-table FULL-PKG-SPEC -> PKG | #f ; return the best on-disk match for the given package spec diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss index 5d3940245c..636eef8822 100644 --- a/collects/planet/resolver.ss +++ b/collects/planet/resolver.ss @@ -400,7 +400,9 @@ attempted to load version ~a.~a while version ~a.~a was already loaded" (state:abort (format "Unknown error ~a receiving package: ~a" code msg))] [bad-response (state:abort (format "Server returned malformed message: ~e" bad-response))])) - (define (state:abort msg) (raise (make-exn:i/o:protocol msg (current-continuation-marks)))) + (define (state:abort msg) + (raise (make-exn:i/o:protocol (string->immutable-string msg) + (current-continuation-marks)))) (define (state:failure msg) (list #f msg)) (with-handlers ([void (lambda (e) (close-ports) (raise e))]) @@ -444,7 +446,8 @@ attempted to load version ~a.~a while version ~a.~a was already loaded" (define (abort msg) (close-input-port ip) - (raise (make-exn:i/o:protocol msg (current-continuation-marks)))) + (raise (make-exn:i/o:protocol (string->immutable-string msg) + (current-continuation-marks)))) (case response-code [(#f) (abort (format "Server returned invalid HTTP response code ~s" response-code/str))]