1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00

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.
This commit is contained in:
Rob Browning 2025-03-19 20:32:53 -05:00
parent 11b027d7e2
commit b3b7477128
2 changed files with 46 additions and 1 deletions

View file

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

View file

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