diff options
Diffstat (limited to 'test-suite/tests/filesys.test')
-rw-r--r-- | test-suite/tests/filesys.test | 227 |
1 files changed, 227 insertions, 0 deletions
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test new file mode 100644 index 000000000..fceb182be --- /dev/null +++ b/test-suite/tests/filesys.test @@ -0,0 +1,227 @@ +;;;; filesys.test --- test file system functions -*- scheme -*- +;;;; +;;;; Copyright (C) 2004, 2006, 2013 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite test-filesys) + #:use-module (test-suite lib) + #:use-module (test-suite guile-test) + #:use-module (ice-9 threads) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (rnrs bytevectors)) + +(define (test-file) + (data-file-name "filesys-test.tmp")) +(define (test-symlink) + (data-file-name "filesys-test-link.tmp")) + + +;;; +;;; copy-file +;;; + +(with-test-prefix "copy-file" + + ;; return next prospective file descriptor number + (define (next-fd) + (let ((fd (dup 0))) + (close fd) + fd)) + + ;; in guile 1.6.4 and earlier, copy-file didn't close the input fd when + ;; the output could not be opened + (pass-if "fd leak when dest unwritable" + (let ((old-next (next-fd))) + (false-if-exception (copy-file "/dev/null" "no/such/dir/foo")) + (= old-next (next-fd))))) + +;;; +;;; lstat +;;; + +(with-test-prefix "lstat" + + (pass-if "normal file" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (eqv? 5 (stat:size (lstat (test-file))))) + + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (false-if-exception (delete-file (test-symlink))) + (if (not (false-if-exception + (begin (symlink (test-file) (test-symlink)) #t))) + (display "cannot create symlink, lstat test skipped\n") + (pass-if "symlink" + ;; not much to test, except that it works + (->bool (lstat (test-symlink)))))) + +;;; +;;; opendir and friends +;;; + +(with-test-prefix "opendir" + + (with-test-prefix "root directory" + (let ((d (opendir "/"))) + (pass-if "not empty" + (string? (readdir d))) + (pass-if "all entries are strings" + (let more () + (let ((f (readdir d))) + (cond ((string? f) + (more)) + ((eof-object? f) + #t) + (else + #f))))) + (closedir d)))) + +;;; +;;; stat +;;; + +(with-test-prefix "stat" + + (with-test-prefix "filename" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (eqv? 5 (stat:size (stat (test-file)))))) + + (with-test-prefix "file descriptor" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let* ((fd (open-fdes (test-file) O_RDONLY)) + (st (stat fd))) + (close-fdes fd) + (eqv? 5 (stat:size st))))) + + (with-test-prefix "port" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let* ((port (open-file (test-file) "r+")) + (st (stat port))) + (close-port port) + (eqv? 5 (stat:size st)))))) + +(with-test-prefix "sendfile" + + (let* ((file (search-path %load-path "ice-9/boot-9.scm")) + (len (stat:size (stat file))) + (ref (call-with-input-file file get-bytevector-all))) + + (pass-if-equal "file" (cons len ref) + (let* ((result (call-with-input-file file + (lambda (input) + (call-with-output-file (test-file) + (lambda (output) + (sendfile output input len 0)))))) + (out (call-with-input-file (test-file) get-bytevector-all))) + (cons result out))) + + (pass-if-equal "file with offset" + (cons (- len 777) (call-with-input-file file + (lambda (input) + (seek input 777 SEEK_SET) + (get-bytevector-all input)))) + (let* ((result (call-with-input-file file + (lambda (input) + (call-with-output-file (test-file) + (lambda (output) + (sendfile output input (- len 777) 777)))))) + (out (call-with-input-file (test-file) get-bytevector-all))) + (cons result out))) + + (pass-if-equal "file with offset past the end" + (cons (- len 777) (call-with-input-file file + (lambda (input) + (seek input 777 SEEK_SET) + (get-bytevector-all input)))) + (let* ((result (call-with-input-file file + (lambda (input) + (call-with-output-file (test-file) + (lambda (output) + (sendfile output input len 777)))))) + (out (call-with-input-file (test-file) get-bytevector-all))) + (cons result out))) + + (pass-if-equal "file with offset near the end" + (cons 77 (call-with-input-file file + (lambda (input) + (seek input (- len 77) SEEK_SET) + (get-bytevector-all input)))) + (let* ((result (call-with-input-file file + (lambda (input) + (call-with-output-file (test-file) + (lambda (output) + (sendfile output input len (- len 77))))))) + (out (call-with-input-file (test-file) get-bytevector-all))) + (cons result out))) + + (pass-if-equal "pipe" (cons len ref) + (if (provided? 'threads) + (let* ((in+out (pipe)) + (child (call-with-new-thread + (lambda () + (call-with-input-file file + (lambda (input) + (let ((result (sendfile (cdr in+out) + (fileno input) + len 0))) + (close-port (cdr in+out)) + result))))))) + (let ((out (get-bytevector-all (car in+out)))) + (close-port (car in+out)) + (cons (join-thread child) out))) + (throw 'unresolved))) + + (pass-if-equal "pipe with offset" + (cons (- len 777) (call-with-input-file file + (lambda (input) + (seek input 777 SEEK_SET) + (get-bytevector-all input)))) + (if (provided? 'threads) + (let* ((in+out (pipe)) + (child (call-with-new-thread + (lambda () + (call-with-input-file file + (lambda (input) + (let ((result (sendfile (cdr in+out) + (fileno input) + (- len 777) + 777))) + (close-port (cdr in+out)) + result))))))) + (let ((out (get-bytevector-all (car in+out)))) + (close-port (car in+out)) + (cons (join-thread child) out))) + (throw 'unresolved))))) + +(delete-file (test-file)) +(when (file-exists? (test-symlink)) + (delete-file (test-symlink))) |