Misc. bugfixes for exceptional cases

svn: r1945
This commit is contained in:
Jacob Matthews 2006-01-24 19:11:16 +00:00
parent cfee2d5429
commit fbc5fc7555
2 changed files with 15 additions and 5 deletions

View File

@ -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

View File

@ -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))]