← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/filesys.test

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
test-suite/tests/filesys.test
 
1
;;;; filesys.test --- test file system functions -*- scheme -*-
 
2
;;;; 
 
3
;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
 
4
;;;; 
 
5
;;;; This library is free software; you can redistribute it and/or
 
6
;;;; modify it under the terms of the GNU Lesser General Public
 
7
;;;; License as published by the Free Software Foundation; either
 
8
;;;; version 2.1 of the License, or (at your option) any later version.
 
9
;;;; 
 
10
;;;; This library is distributed in the hope that it will be useful,
 
11
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
13
;;;; Lesser General Public License for more details.
 
14
;;;; 
 
15
;;;; You should have received a copy of the GNU Lesser General Public
 
16
;;;; License along with this library; if not, write to the Free Software
 
17
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
18
 
 
19
(define-module (test-suite test-filesys)
 
20
  #:use-module (test-suite lib)
 
21
  #:use-module (test-suite guile-test))
 
22
 
 
23
(define (test-file)
 
24
  (data-file-name "filesys-test.tmp"))
 
25
(define (test-symlink)
 
26
  (data-file-name "filesys-test-link.tmp"))
 
27
 
 
28
 
 
29
;;;
 
30
;;; copy-file
 
31
;;;
 
32
 
 
33
(with-test-prefix "copy-file"
 
34
 
 
35
  ;; return next prospective file descriptor number
 
36
  (define (next-fd)
 
37
    (let ((fd (dup 0)))
 
38
      (close fd)
 
39
      fd))
 
40
 
 
41
  ;; in guile 1.6.4 and earlier, copy-file didn't close the input fd when
 
42
  ;; the output could not be opened
 
43
  (pass-if "fd leak when dest unwritable"
 
44
    (let ((old-next (next-fd)))
 
45
      (false-if-exception (copy-file "/dev/null" "no/such/dir/foo"))
 
46
      (= old-next (next-fd)))))
 
47
 
 
48
;;;
 
49
;;; lstat
 
50
;;;
 
51
 
 
52
(with-test-prefix "lstat"
 
53
 
 
54
  (pass-if "normal file"
 
55
    (call-with-output-file (test-file)
 
56
      (lambda (port)
 
57
        (display "hello" port)))
 
58
    (eqv? 5 (stat:size (lstat (test-file)))))
 
59
 
 
60
  (call-with-output-file (test-file)
 
61
    (lambda (port)
 
62
      (display "hello" port)))
 
63
  (false-if-exception (delete-file (test-symlink)))
 
64
  (if (not (false-if-exception
 
65
            (begin (symlink (test-file) (test-symlink)) #t)))
 
66
      (display "cannot create symlink, lstat test skipped\n")
 
67
      (pass-if "symlink"
 
68
        ;; not much to test, except that it works
 
69
        (->bool (lstat (test-symlink))))))
 
70
 
 
71
;;;
 
72
;;; opendir and friends
 
73
;;;
 
74
 
 
75
(with-test-prefix "opendir"
 
76
 
 
77
  (with-test-prefix "root directory"
 
78
    (let ((d (opendir "/")))
 
79
      (pass-if "not empty"
 
80
        (string? (readdir d)))
 
81
      (pass-if "all entries are strings"
 
82
        (let more ()
 
83
          (let ((f (readdir d)))
 
84
            (cond ((string? f)
 
85
                   (more))
 
86
                  ((eof-object? f)
 
87
                   #t)
 
88
                  (else
 
89
                   #f)))))
 
90
      (closedir d))))
 
91
 
 
92
;;;
 
93
;;; stat
 
94
;;;
 
95
 
 
96
(with-test-prefix "stat"
 
97
 
 
98
  (with-test-prefix "filename"
 
99
 
 
100
    (pass-if "size"
 
101
      (call-with-output-file (test-file)
 
102
        (lambda (port)
 
103
          (display "hello" port)))
 
104
      (eqv? 5 (stat:size (stat (test-file))))))
 
105
 
 
106
  (with-test-prefix "file descriptor"
 
107
 
 
108
    (pass-if "size"
 
109
      (call-with-output-file (test-file)
 
110
        (lambda (port)
 
111
          (display "hello" port)))
 
112
      (let* ((fd (open-fdes (test-file) O_RDONLY))
 
113
             (st (stat fd)))
 
114
        (close-fdes fd)
 
115
        (eqv? 5 (stat:size st)))))
 
116
 
 
117
  (with-test-prefix "port"
 
118
 
 
119
    (pass-if "size"
 
120
      (call-with-output-file (test-file)
 
121
        (lambda (port)
 
122
          (display "hello" port)))
 
123
      (let* ((port (open-file (test-file) "r+"))
 
124
             (st   (stat port)))
 
125
        (close-port port)
 
126
        (eqv? 5 (stat:size st))))))
 
127
 
 
128
(delete-file (test-file))
 
129
(delete-file (test-symlink))