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")))