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:
parent
11b027d7e2
commit
b3b7477128
2 changed files with 46 additions and 1 deletions
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue