errno as property of condition objects added by mario-goulart on Sat Jan 6 11:07:47 2024
diff --git a/file.scm b/file.scm index 78d68a41..e69fe877 100644 --- a/file.scm +++ b/file.scm @@ -225,11 +225,11 @@ EOF (define (delete-file filename) (##sys#check-string filename 'delete-file) (unless (eq? 0 (##core#inline "C_remove" (##sys#make-c-string filename 'delete-file))) - (##sys#update-errno) - (##sys#signal-hook - #:file-error 'delete-file - (##sys#string-append "cannot delete file - " strerror) filename)) - filename) + (let ((err (##sys#update-errno))) + (##sys#signal-hook/errno + #:file-error err 'delete-file + (##sys#string-append "cannot delete file - " strerror) filename)) + filename)) (define (delete-file* file) (and (file-exists? file) (delete-file file))) diff --git a/library.scm b/library.scm index 7341bb66..d88d145c 100644 --- a/library.scm +++ b/library.scm @@ -5105,7 +5105,7 @@ EOF (import scheme chicken.base chicken.fixnum chicken.foreign) (import chicken.internal.syntax) -(define (##sys#signal-hook mode msg . args) +(define (##sys#signal-hook/errno mode errno msg . args) (##core#inline "C_dbg_hook" #f) (##core#inline "signal_debug_event" mode msg args) (case mode @@ -5132,7 +5132,7 @@ EOF (##sys#write-char-0 #\newline ##sys#standard-error)))) args) (##sys#flush-output ##sys#standard-error)] - [else + (else (when (and (symbol? msg) (null? args)) (set! msg (symbol->string msg))) (let* ([hasloc (and (or (not msg) (symbol? msg)) (pair? args))] @@ -5158,10 +5158,16 @@ EOF [(#:domain-error) '(exn domain)] ((#:memory-error) '(exn memory)) [else '(exn)] ) - (list '(exn . message) msg - '(exn . arguments) args - '(exn . call-chain) (get-call-chain) - '(exn . location) loc) ) ) ) ] ) ) + (list '(exn . message) msg + '(exn . arguments) args + '(exn . call-chain) (get-call-chain) + '(exn . location) loc + '(exn . errno) (or errno 0)))))))) + +(define (##sys#signal-hook mode msg . args) + (if (null? args) + (##sys#signal-hook/errno mode #f msg) + (apply ##sys#signal-hook/errno (append (list mode #f msg) args)))) (define (abort x) (##sys#current-exception-handler x) ;;;;;;;;;;;;;;;;;;;;;;; ;;;; Usage example ;;;; ;;;;;;;;;;;;;;;;;;;;;;; (import (chicken condition) (chicken errno) (chicken file)) (define (with-ignored-noent thunk) (handle-exceptions exn (when (and ((condition-predicate 'i/o) exn) ((condition-predicate 'file) exn)) (let ((err (get-condition-property exn 'exn 'errno))) (print err) (unless (= err errno/noent) (signal exn)))) (thunk))) (with-ignored-noent (lambda () (delete-file "dir/foo")))