diff options
author | Kevin Ryde <user42@zip.com.au> | 2006-04-16 23:37:40 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2006-04-16 23:37:40 +0000 |
commit | 6e7d5622eebd416d95e487cc358ee19d0a22c762 (patch) | |
tree | 405ef9b19ae23d270bf990aa994fe7497d506a36 /test-suite/tests/filesys.test | |
parent | 1b09b607dd1096ab572afe0667e8602560622624 (diff) | |
download | guile-6e7d5622eebd416d95e487cc358ee19d0a22c762.tar.gz |
merge from 1.8 branch
Diffstat (limited to 'test-suite/tests/filesys.test')
-rw-r--r-- | test-suite/tests/filesys.test | 92 |
1 files changed, 90 insertions, 2 deletions
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 6ccb021ea..7ba4feb06 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -1,6 +1,6 @@ ;;;; filesys.test --- test file system functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 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 @@ -17,7 +17,14 @@ ;;;; 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 lib) + #:use-module (test-suite guile-test)) + +(define (test-file) + (data-file-name "filesys-test.tmp")) +(define (test-symlink) + (data-file-name "filesys-test-link.tmp")) + ;;; ;;; copy-file @@ -37,3 +44,84 @@ (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))) + (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)))))) + |