From b3b74771281dd3d59b2d082d5fee91b1b99b966b Mon Sep 17 00:00:00 2001
From: Rob Browning <rlb@defaultvalue.org>
Date: Wed, 19 Mar 2025 20:32:53 -0500
Subject: [PATCH] Add missing, read-only, and typical copy-file tests

* test-suite/guile-test: add call-with-temp-dir and exception-errno.
* test-suite/tests/filesys.test: add further copy-file tests.
---
 test-suite/guile-test         | 21 ++++++++++++++++++++-
 test-suite/tests/filesys.test | 26 ++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/test-suite/guile-test b/test-suite/guile-test
index 12597ff55..ef742523b 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -92,7 +92,11 @@
   :use-module (system vm vm)
   #:declarative? #f
   :use-module ((test-suite lib automake) :prefix automake/)
-  :export (main data-file-name test-file-name))
+  :export (call-with-temp-dir
+           data-file-name
+           exception-errno
+           main
+           test-file-name))
 
 
 ;;; User configurable settings:
@@ -111,6 +115,21 @@
 
 ;;; General utilities, that probably should be in a library somewhere.
 
+(define-syntax-rule (call-with-temp-dir template f)
+  "Call (f tempdir) with a temporary directory created by (mkdtemp
+template) that is always removed on exit from f."
+  (let ((tmpdir (mkdtemp template)))
+    (dynamic-wind
+      (const #f)
+      (λ () (f tmpdir))
+      (λ ()
+        (unless (zero? (status:exit-val (system* "rm" "-rf" tmpdir)))
+          (error "Unable to remove temporary directory: " tmpdir))))))
+
+(define (exception-errno ex)
+  "Return the errno value from the system-error derived &exception ex."
+  (car (list-ref (exception-args ex) 3)))
+
 ;;; Enable debugging
 (define (enable-debug-mode)
   (write-line %load-path)
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index cc0e1f3c6..4d15de0dd 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -44,6 +44,32 @@
 
 (with-test-prefix "copy-file"
 
+  (with-test-prefix "missing source"
+    (with-exception-handler
+        (λ (ex) (pass-if-equal "errno is ENOENT" ENOENT (exception-errno ex)))
+      (λ () (copy-file "this-file-should-not-exist" "somewhere"))
+      #:unwind? #t))
+
+  (call-with-temp-dir
+   "copy-file-XXXXXX"
+   (λ (tmpdir)
+     (let ((msg "this is a test, this is only a test...\n")
+           (src (string-append tmpdir "/" "source"))
+           (dest (string-append tmpdir "/" "read-only-dest")))
+       (call-with-output-file src (λ (p) (display msg p)))
+       (call-with-output-file dest identity)
+       (with-test-prefix "successful copy"
+         (copy-file src dest)
+         (pass-if-equal "copy-file dest content" msg
+           (call-with-input-file dest get-string-all)))
+       (with-test-prefix "read only dest"
+         (chmod dest #o444)
+         (with-exception-handler
+             (λ (ex)
+               (pass-if-equal "errno is EACCES" EACCES (exception-errno ex)))
+           (λ () (copy-file src dest))
+           #:unwind? #t)))))
+
   ;; return next prospective file descriptor number
   (define (next-fd)
     (let ((fd (dup 0)))