Misc. bugfixes for exceptional cases
svn: r1945
This commit is contained in:
parent
cfee2d5429
commit
fbc5fc7555
|
@ -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
|
||||
|
|
|
@ -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))]
|
||||
|
|
Loading…
Reference in New Issue
Block a user