1;;; 2;;; srfi-1981 - POSIX system call exceptions 3;;; 4;;; Copyright (c) 2020 Shiro Kawai <shiro@acm.org> 5;;; 6;;; Redistribution and use in source and binary forms, with or without 7;;; modification, are permitted provided that the following conditions 8;;; are met: 9;;; 10;;; 1. Redistributions of source code must retain the above copyright 11;;; notice, this list of conditions and the following disclaimer. 12;;; 13;;; 2. Redistributions in binary form must reproduce the above copyright 14;;; notice, this list of conditions and the following disclaimer in the 15;;; documentation and/or other materials provided with the distribution. 16;;; 17;;; 3. Neither the name of the authors nor the names of its contributors 18;;; may be used to endorse or promote products derived from this 19;;; software without specific prior written permission. 20;;; 21;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 27;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 28;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 29;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 30;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 31;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32;;; 33 34;; Gauche traditionally used <system-error> for system call exceptions. 35;; srfi-198 adds a few fields that are not in <system-error>. So we use 36;; compound condition for that. Note that syscall-error? responds #t 37;; to a bare <system-error> as well, for the interoperability. 38;; We may integrate those extra slots to <system-error> eventually, so 39;; do not rely on this internal arrangement. 40 41(define-module srfi-198 42 (export make-syscall-error 43 syscall-error? 44 syscall-error:errno 45 syscall-error:message 46 syscall-error:procedure-name 47 syscall-error:syscall-name 48 syscall-error:data 49 errno-error)) 50(select-module srfi-198) 51 52(define-condition-type <syscall-error-mixin> <condition> 53 #f 54 (procedure-name) 55 (syscall-name) 56 (data)) 57 58(define (make-syscall-error errno message procedure-name syscall-name data) 59 (condition (<system-error> 60 (errno errno) 61 (message message)) 62 (<syscall-error-mixin> 63 (procedure-name procedure-name) 64 (syscall-name syscall-name) 65 (data data)))) 66 67(define (syscall-error? x) (condition-has-type? x <system-error>)) 68 69(define (syscall-error:errno x) 70 (assume (syscall-error? x)) 71 (condition-ref x 'errno)) 72 73(define (syscall-error:message x) 74 (assume (syscall-error? x)) 75 (condition-ref x 'message)) 76 77(define (syscall-error:procedure-name x) 78 (assume (syscall-error? x)) 79 (if (condition-has-type? x <syscall-error-mixin>) 80 (condition-ref x 'procedure-name) 81 'unknown)) 82 83(define (syscall-error:syscall-name x) 84 (assume (syscall-error? x)) 85 (if (condition-has-type? x <syscall-error-mixin>) 86 (condition-ref x 'syscall-name) 87 'unknown)) 88 89(define (syscall-error:data x) 90 (assume (syscall-error? x)) 91 (if (condition-has-type? x <syscall-error-mixin>) 92 (condition-ref x 'data) 93 '())) 94 95(define (errno-error errno procedure-name syscall-name . objs) 96 (raise (make-syscall-error errno 97 (sys-strerror errno) 98 procedure-name 99 syscall-name 100 objs))) 101