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

minor tweaks, better errors

Browse Source 
svn: r1475
This commit is contained in:
Eli Barzilay 2005-12-01 22:51:13 +00:00
parent b165f5400c
commit 83c4f5ebe8
2 changed files with 24 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/version/check.ss
View File

@ -5,26 +5,33 @@
(require (lib "url.ss" "net")) (require (lib "url.ss" "net"))
(define (error-value what . more) (define error-value
`(error ,what ,@more)) (case-lambda
[(what) `(error ,what)]
[(what more)
`(error ,what
,(cond [(list? more) (format "~a" more)]
[(exn? more) (format "(~a)" (exn-message more))]
[else (format "(~a)" more)]))]))
(define (with-timeout timeout thunk) (define (with-timeout timeout thunk)
(define result #f) (define result #f)
(let ([r (sync/timeout timeout (let ([r (sync/timeout timeout
(thread (lambda () (set! result (thunk)))))]) (thread (lambda ()
(set! result
(with-handlers
([void (lambda (e)
(error-value "internal error" e))])
(thunk))))))])
(if r result (error-value "timeout")))) (if r result (error-value "timeout"))))
(define (check-version/timeout) (define (check-version/timeout)
(let/ec escape (let/ec escape
(define (err . args) (define (err . args) (escape (apply error-value args)))
(escape (apply error-value args)))
(define-syntax try (define-syntax try
(syntax-rules () (syntax-rules ()
[(_ expr error-message) [(_ expr error-message)
(with-handlers (with-handlers ([void (lambda (e) (err error-message e))]) expr)]))
([void (lambda (e)
(err error-message (if (exn? e) (exn-message e) e)))])
expr)]))
;; Get server information, carefully ;; Get server information, carefully
(define version-info (define version-info
(parameterize ([current-input-port (parameterize ([current-input-port
@ -37,8 +44,9 @@
(unless (and (list? version-info) (unless (and (list? version-info)
(andmap (lambda (x) (andmap (lambda (x)
(and (list? x) (and (list? x)
(= 2 (length x))
(symbol? (car x)) (symbol? (car x))
(= 2 (length x)))) (string? (cadr x))))
version-info)) version-info))
(err "bad response from server" version-info)) (err "bad response from server" version-info))
;; Make a decision ;; Make a decision
@ -71,7 +79,7 @@
;; also the alpha version ;; also the alpha version
;; * `(error ,message [,additional-info]) ;; * `(error ,message [,additional-info])
;; An error occured, the third (optional) value can be shown as the system ;; An error occured, the third (optional) value can be shown as the system
;; error that happened. ;; error that happened or the value that caused an error.
(provide check-version) (provide check-version)
(define (check-version) (define (check-version)
(with-timeout timeout check-version/timeout)) (with-timeout timeout check-version/timeout))

9
collects/version/doc.txt
View File

@ -23,10 +23,11 @@ your current state -- one of these:
you may consider also the newer alpha version you may consider also the newer alpha version
* `(error ,message [,additional-info]) * `(error ,message [,additional-info])
An error occured, the message is a string that indicates the An error occured, the message is a string that indicates the
error, and the third (optional) value can be shown as the system error.
error that happened (it may be a string for system errors, or a The third (optional) value is a string that can be shown as the
datum for an unexpected input from the web). system error that happened. This string will always be
parenthesized, so `message' is a short error and
`(string-append message " " additional-info)' is a verbose one.
The second functionality that is provided by this collection is in the The second functionality that is provided by this collection is in the
_patchlevel_ module. This module provides a single value: _patchlevel_ module. This module provides a single value: