guile18/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))