io-error and raise/strerr now include an &error condition.

This commit is contained in:
Abdulaziz Ghuloum 2008-06-06 08:10:17 -07:00
parent af5472bfb2
commit df4b31af1f
3 changed files with 24 additions and 19 deletions

View File

@ -1186,26 +1186,30 @@
(eof-object? (lookahead-u8 p)))] (eof-object? (lookahead-u8 p)))]
[else (die 'port-eof? "not an input port" p)]))) [else (die 'port-eof? "not an input port" p)])))
;;; FIXME: these hard coded constants should go away
(define EAGAIN-error-code -6) ;;; from ikarus-errno.c (define EAGAIN-error-code -6) ;;; from ikarus-errno.c
(define (io-error who id err . other-conditions) (define io-error
(raise (case-lambda
(apply condition [(who id err base-condition)
(make-who-condition who) (raise
(make-message-condition (strerror err)) (condition
(case err base-condition
;; from ikarus-errno.c: EACCES=-2, EFAULT=-21, EROFS=-71, EEXIST=-20, (make-who-condition who)
;; EIO=-29, ENOENT=-45 (make-message-condition (strerror err))
;; Why is EFAULT included here? (case err
[(-2 -21) (make-i/o-file-protection-error id)] ;; from ikarus-errno.c: EACCES=-2, EFAULT=-21, EROFS=-71, EEXIST=-20,
[(-71) (make-i/o-file-is-read-only-error id)] ;; EIO=-29, ENOENT=-45
[(-20) (make-i/o-file-already-exists-error id)] ;; Why is EFAULT included here?
[(-29) (make-i/o-error)] [(-2 -21) (make-i/o-file-protection-error id)]
[(-45) (make-i/o-file-does-not-exist-error id)] [(-71) (make-i/o-file-is-read-only-error id)]
[else (if id [(-20) (make-i/o-file-already-exists-error id)]
(make-irritants-condition (list id)) [(-29) (make-i/o-error)]
(condition))]) [(-45) (make-i/o-file-does-not-exist-error id)]
other-conditions))) [else (if id
(make-irritants-condition (list id))
(condition))])))]
[(who id err) (io-error who id err (make-error))]))
;(define block-size 4096) ;(define block-size 4096)
;(define block-size (* 4 4096)) ;(define block-size (* 4 4096))

View File

@ -260,6 +260,7 @@
[(who errno-code filename) [(who errno-code filename)
(raise (raise
(condition (condition
(make-error)
(make-who-condition who) (make-who-condition who)
(make-message-condition (strerror errno-code)) (make-message-condition (strerror errno-code))
(if filename (if filename

View File

@ -1 +1 @@
1499 1500